Hi i need to get column of a cell with the text as ACTION.
My current code is as below.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim actionColName As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 3 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& "+ " & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
In the above code there is a condition as below
If Target.Column = 3 Then
Instead of hard coding the value with 3 i would like to apply this logic for the complete column which contains the value ACTION in one of its cell in that column.
Use a Find to determine the (first) column containing Action
Sub GetAction()
Dim rng1 As Range
Set rng1 = ActiveSheet.UsedRange.Find("Action", , xlValues, xlWhole)
If Not rng1 Is Nothing Then
MsgBox "Found in column " & rng1.Column
Else
MsgBox "Not found", vbCritical
End If
End Sub
Related
I have the following code which works to an extent with data validation on a predefined list on aa separate sheet. The issue I am having is that the drop down list lets me select an item more than once. However, I want to be able to select an Item only once.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
I'm trying to have a pop up option come up where a user can select from a list and that is inputted into a cell and the values are separated by commas. I got my VBA code to function but I only want this to be tied to a specific cell ranges rather than the data validation list in basically any cell range.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
Application.EnableEvents = False
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Not Intersect(Target, rngDV) Is Nothing Then
If Target.Validation.Type = 3 Then
strList = Target.Validation.Formula1
strList = Right(strList, Len(strList) - 1)
strDVList = strList
frmDVList.Show
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If newVal = "" Then
'do nothing
Else
If oldVal = "" Then
Target.Value = newVal
Else
Target.Value = oldVal & strSep & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
I think I need to update the Private Sub Worksheet_SelectionChange(ByVal Target As Range) but when I select a cell range like G1:G100, it causes debug issue.
Also, how can I have the data validation list always show up in Column 'G'?
I'm working on an VBA-Code right now, which should:
let you select a text from a dropdown-list
select multiple text and put it on the next line
let you edit the values of the cell.
The Problem here is that when I disable the Error message - so I can edit the cell, the values from the target cell get added to the cell.
So for example I want to edit B to C in the Dropdown cell.
Instead I get A B A C
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String
On Error GoTo Errorhandling
If Not Application.Intersect(Target, Range("A6")) Is Nothing Then
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
If Not Application.Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
wertnew = Target.Value
Application.Undo
wertold = Target.Value
Target.Value = wertnew
If wertold <> "" Then
If wertnew <> "" Then
Target.Value = wertold & vbCrLf & wertnew
End If
End If
End If
Application.EnableEvents = True
End If
Errorhandling:
Application.EnableEvents = True
End Sub
You must use vbLf as linebreak in cells instead of vbCrLf
Use Option Explicit to prevent using wrong variable names. You declared wert_old but you used wertold. This will easily mess up and drive you nuts. I recommend always to activate Option Explicit: In the VBA editor go to Tools › Options › Require Variable Declaration.
As a workaround you can run your code only if it doesn't contain a vbLf by using
InStr(1, Target.Value, vbLf) < 1
Note that this workaround will make you able to edit the cell if there is more than one item in it but if you try to edit if it only contains one item it will still add it (I have no workaround for that).
So you end up with something like:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Errorhandling
If Not Application.Intersect(Target, Me.Range("A6")) Is Nothing Then
Dim rngDV As Range
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
If Not Application.Intersect(Target, rngDV) Is Nothing And InStr(1, Target.Value, vbLf) < 1 Then
Application.EnableEvents = False
Dim WertNew As String
WertNew = Target.Value
Application.Undo
Dim WertOld As String
WertOld = Target.Value
Target.Value = WertNew
If WertOld <> vbNullString Then
If WertNew <> vbNullString Then
Target.Value = WertOld & vbLf & WertNew
End If
End If
End If
Application.EnableEvents = True
End If
Errorhandling:
Application.EnableEvents = True
End Sub
I have a listbox that opens when I double-click the cell. When I select multiple items in the listbox and hit okay it will put these items in the cell. BUT if I want to go to the cell afterwards (select cell and hit F2) and modify the entry it will add my modification but also duplicate what the listbox put in there before. I just want the modification. How can I stop the duplication?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lType As Long
Dim strList As String
Application.EnableEvents = False
On Error Resume Next
lType = Target.Validation.Type
On Error GoTo exitHandler
If lType = 3 Then
Cancel = True
strList = Target.Validation.Formula1
strList = Right(strList, Len(strList) - 1)
strDVList = strList
frmDVList.Show
End If
exitHandler:
Application.EnableEvents = True
End Sub
----------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = "; "
Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
Else
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If newVal = "" Then
Else
If oldVal = "" Then
Target.Value = newVal
Else
Target.Value = oldVal & strSep & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
I have developed on my excel spreadsheet that multiple items can be selected in a drop down list using the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
Else
If newVal = "" Then
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
But, I want to now validate the answers that the drop down list items can only be selected once. And preferably, if the user selects that item again, that is it then removed.
Any help would be greatly appreciated.
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Const SEP As String = ", "
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim arr, m, v
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Target.SpecialCells(xlCellTypeSameValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then Exit Sub
newVal = Target.Value
If Len(newVal) = 0 Then Exit Sub 'user has cleared the cell...
Application.EnableEvents = False
Application.Undo
oldVal = Target.Value
If oldVal <> "" Then
arr = Split(oldVal, SEP)
m = Application.Match(newVal, arr, 0)
If IsError(m) Then
newVal = oldVal & SEP & newVal
Else
arr(m - 1) = ""
newVal = ""
For Each v In arr
If Len(v) > 0 Then newVal = newVal & IIf(Len(newVal) > 0, SEP, "") & v
Next v
End If
Target.Value = newVal
Else
Target.Value = newVal 'EDIT
End If
exitHandler:
Application.EnableEvents = True
End Sub