Fairly new to VBA and Macros, and I would need assistance in combining these 2 worksheet events. Both work individually and I haven't found a way to combine them to run.
Macro 1: Automatically updating Timestamp Data Entries
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange As Range
Dim myDateTimeRange As Range
Dim myUpdatedRange As Range
Set myTableRange = Range("W4:W3000")
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set myDateTimeRange = Range("AF" & Target.Row)
Set myUpdatedRange = Range("AG" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
myUpdatedRange.Value = Now
Application.EnableEvents = True
End Sub
Macro 2: Allowing for multiple selection in Dropdown lists
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or _
InStr(1, xValue1, "; " & xValue2) Or _
InStr(1, xValue1, xValue2 & ";") Then
Target.Value = xValue1
Else
Target.Value = xValue1 & "; " & xValue2
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
Any help/guidance would be greatly appreciated.
Thank you!
CodePudding user response:
Create a module and add two subs there:
Option Explicit
Public Sub updateTimestampDataEntries(ByVal c As Range)
'put the code here - using c instead of target
End Sub
Public Sub allowMultipleSelectionDropdown(ByVal c As Range)
'put the code here - using c instead of target
End Sub
Then you can use these subs within your worksheet_events like this
Private Sub Worksheet_Change(ByVal Target As Range)
dim c as Range: set c = Target.Cells(1,1) 'only check the first cell
If Not Application.Intersect(c, rgMyTable) Is Nothing Then
updateTimestampDataEntries c
ElseIf not Application.Intersect(c, rgValidationLists) Is Nothing Then
allowMultipleSelectionDropdown c
End If
End Sub
Private Property Get rgMyTable() as Range
'put your code here
set rgMyTable = ...
End Property
Private Property Get rgValidationLists as range
'put your code here
set rgValidationLists = ...
End Property