Multiple Excel VBA Worksheet Change Events Triggered from Value Changes in Multiple Columns-CodePudding

I have a process where there needs to be multiple timestamps based on the decisions of multiple individuals. Essentially, I need timestamps in the right location per each decision. I've created multiple Worksheet_Change subroutines that work alone, but you can't have multiple Worksheet_Change subroutines. I have no idea how to put this into one subroutine or allow multiple to function.

Below are three subroutines that seem to work alone (there are 5 total). Note each macro has a different triggering column.

Macro 1

Puts timestamps based on Column A status changes

Private Sub Worksheet_Change(ByVal Target As Range) ' status change
   Dim A As Range
   Set A = Range("A:A")
   Dim v As String
     If Intersect(Target, A) Is Nothing Then Exit Sub
      v = Target.Value
      If v = "1. Submitted" Then Target.Offset(0, 10) = Now() 'column K
      If v = "2. In Review" Then Target.Offset(0, 13) = Now() 'column N
      If v = "4. On Hold" Then Target.Offset(0, 54) = Now() 'column BC
      If v = "5. "Submitted" Then Target.Offset(0, 61) = Now()
      If v = "C. Complete" Then Target.Offset(0, 63) = Now() 'column BL
      If v = "D. Discontinued" Then Target.Offset(0, 63) = Now() 'column BL
      If v = "3. Pursuing" Then MsgBox "Reminder: There is no macro action for this status change"
   Application.EnableEvents = True
End Sub

Macro 2

First layer of review, including saying its ready to move onto the next layer of review if yes and providing information about rejection if no.

    Private Sub Worksheet_Change(ByVal Target As Range) '1st Decision
       Dim A As Range
       Set A = Range("T:T") 'column 20
       Dim v As String
       If Intersect(Target, A) Is Nothing Then Exit Sub
        v = Target.Value
        If v = "Yes" Then
            Target.Offset(0, -3) = Now() 'column R, stamp
            Target.Offset(0, -5) = "2b. LA"
        End If
        If v = "No" Then
            Target.Offset(0, -3) = Now() 'column R stamp
            Target.Offset(0, 45) = Now() 'Column BL timestamp
            Target.Offset(0, -20) = "R. Rejected" 'Rejection status change
            Target.Offset(0, 50) = "" 'rejection level column BQ
            Target.Offset(0, 51) = Target.Offset(0, -4) 'copy rejecter
            MsgBox "Make sure you include reason for rejection"
        End If
       Application.EnableEvents = True
    End Sub

Marco 3

Second layer of reviews. Note that the Yes/No is in a different column than the previous macro.

Private Sub Worksheet_Change(ByVal Target As Range) '2nd Decision
       Dim A As Range
       Set A = Range("Y:Y") 'column 25
       Dim v As String
       If Intersect(Target, A) Is Nothing Then Exit Sub
        v = Target.Value
        If v = "Yes" Then
            Target.Offset(0, -3) = Now() 'column W, stamp
            Target.Offset(0, -10) = "2c. SA"
        End If
        If v = "No" Then
            Target.Offset(0, -3) = Now() 'column W stamp
            Target.Offset(0, 40) = Now() 'Column BL timestamp
            Target.Offset(0, -25) = "R. Rejected" 'Rejection status change
            Target.Offset(0, 45) = "LA" 'rejection level column BQ
            Target.Offset(0, 46) = Target.Offset(0, -5) 'copy rejecter
            MsgBox "Make sure you include reason for rejection"
        End If
       Application.EnableEvents = True
    End Sub

Credit to original code How to add a timestamp when a cell data is equal to certain values

CodePudding user response：

Here's your code refactored to check for changes in multiple locations in a single Worksheet_Change event. It's much easier to use and read when using column references instead of offset numbers. Also note that when I converted your offset numbers, they didn't match your comments, so double check that these are where they're supposed to be (for example, column T offset -3 is actually column Q, not R)

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rChanged As Range
    Dim ChangedCell As Range
    
    Application.EnableEvents = False   'Disable events to prevent the code from infinitely calling itself
    
    'Check for changes in column A
    Set rChanged = Nothing
    Set rChanged = Intersect(Target, Me.Columns("A"))
    If Not rChanged Is Nothing Then
        For Each ChangedCell In rChanged.Cells
            Select Case ChangedCell.Value
                Case "1. Submitted":                    Me.Cells(ChangedCell.Row, "K").Value = Now()
                Case "2. In Review":                    Me.Cells(ChangedCell.Row, "N").Value = Now()
                Case "4. On Hold":                      Me.Cells(ChangedCell.Row, "BC").Value = Now()
                Case "5. Submitted":                    Me.Cells(ChangedCell.Row, "BJ").Value = Now()
                Case "C. Complete", "D. Discontinued":  Me.Cells(ChangedCell.Row, "BL").Value = Now()
                Case "3. Pursuing":                     MsgBox "Reminder: There is no macro action for this status change"
            End Select
        Next ChangedCell
    End If
    
    'Check for changes in column T
    Set rChanged = Nothing
    Set rChanged = Intersect(Target, Me.Columns("T"))
    If Not rChanged Is Nothing Then
        For Each ChangedCell In rChanged.Cells
            If ChangedCell.Value = "Yes" Then
                Me.Cells(ChangedCell.Row, "Q").Value = Now()
                Me.Cells(ChangedCell.Row, "O").Value = "2b. LA"
            ElseIf ChangedCell.Value = "No" Then
                Me.Cells(ChangedCell.Row, "Q").Value = Now()
                Me.Cells(ChangedCell.Row, "BM").Value = Now()
                Me.Cells(ChangedCell.Row, "A").Value = "R. Rejected"
                Me.Cells(ChangedCell.Row, "BR").ClearContents
                Me.Cells(ChangedCell.Row, "BS").Value = Me.Cells(ChangedCell.Row, "P").Value
                MsgBox "Make sure you include reason for rejection"
            End If
        Next ChangedCell
    End If
    
    'Check for changes in column Y
    Set rChanged = Nothing
    Set rChanged = Intersect(Target, Me.Columns("Y"))
    If Not rChanged Is Nothing Then
        For Each ChangedCell In rChanged.Cells
            If ChangedCell.Value = "Yes" Then
                Me.Cells(ChangedCell.Row, "V").Value = Now()
                Me.Cells(ChangedCell.Row, "O").Value = "2c. SA"
            ElseIf ChangedCell.Value = "No" Then
                Me.Cells(ChangedCell.Row, "V").Value = Now()
                Me.Cells(ChangedCell.Row, "BM").Value = Now()
                Me.Cells(ChangedCell.Row, "A").Value = "R. Rejected"
                Me.Cells(ChangedCell.Row, "BR").Value = "LA"
                Me.Cells(ChangedCell.Row, "BS").Value = Me.Cells(ChangedCell.Row, "T").Value
                MsgBox "Make sure you include reason for rejection"
            End If
        Next ChangedCell
    End If
    
    Application.EnableEvents = True    'Re-enable events at end of code to be ready for next operation
    
End Sub

CodePudding user response：

Here's another approach:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range, col As String
    'any change(s) in columns of interest?
    Set rng = Application.Intersect(Target, Me.Range("A:A,T:T,Y:Y"))
    If rng Is Nothing Then Exit Sub 'no action needed
    
    Application.EnableEvents = False
    For Each c In rng.Cells 'handle each changed cell
        col = Replace(c.Address(False, False), c.Row, "") 'column letter
        Select Case col
            Case "A": HandleA c
            Case "T": HandleT c
            Case "Y": HandleY c
        End Select
    Next c
    
haverror:
    Application.EnableEvents = True
End Sub

'These subs can be in the sheet code module, or a regular module
Sub HandleA(c As Range)
    Dim rw As Range
    Set rw = c.EntireRow
    Select Case c.Value
        Case "1. Submitted": rw.Columns("K").Value = Now()
        Case "2. In Review": rw.Columns("N").Value = Now()
        Case "4. On Hold": rw.Columns("BC").Value = Now()
        Case "5. Submitted": rw.Columns("BJ").Value = Now()
        Case "C. Complete", "D. Discontinued":
            rw.Columns("BL").Value = Now()
        Case "3. Pursuing": MsgBox "Reminder: There is no macro action for this status change"
    End Select
End Sub

Sub HandleT(c As Range)
    Debug.Print "column T:" & c.Address  'implement your code here
End Sub

Sub HandleY(c As Range)
    Debug.Print "column Y:" & c.Address  'implement your code here
End Sub

CodePudding user response：

As the comments state, you just need some if statements. Something like this to identify where the event took place:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = Range("A:A").Column Then
        'first macro...
        
    ElseIf Target.Column = Range("T:T").Column Then
        'second macro....
        
    ElseIf Target.Column = Range("Y:Y").Column Then
        'third macro....
    
    End If

End Sub