Home > Software engineering >  Combining 2 Worksheet Change Events in 1 Worksheet
Combining 2 Worksheet Change Events in 1 Worksheet

Time:08-10

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
  • Related