How to deal with 2 macro in 1 worksheet?-CodePudding

I'm struggle with this situation.

I have these 2 macros that do not work together in the same worksheet.

First

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim rng As Range

    Dim cell As Range

    Set rng = Intersect(Target, Range("C:C"))
    

'   Exit if no updates made to desired range

    If rng Is Nothing Then Exit Sub

    

'   Loop through cells just updated

    Application.EnableEvents = False

    For Each cell In rng

        Cells(cell.Row, "B") = Application.UserName
        Cells(cell.Row, "A") = Format(Date, "dd.mm.yyyy")
        

    Next cell
    
     Application.EnableEvents = True

  

End Sub

And second

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim rng1 As Range

    Dim cell As Range

    Set rng1 = Intersect(Target, Range("G:G"))
    

'   Exit if no updates made to desired range

    If rng1 Is Nothing Then Exit Sub

    

'   Loop through cells just updated

    Application.EnableEvents = False

    For Each cell In rng1

        Cells(cell.Row, "F") = Application.UserName
        Cells(cell.Row, "E") = Format(Date, "dd.mm.yyyy")
        

    Next cell
    
     Application.EnableEvents = True

  

End Sub

I tried to get application.username in a specific column but the same row with the modified cell from another specific column. All of this but different ranges, in the same worksheet. Is it possible to combine these 2 macros in only one?

CodePudding user response：

Obviously, you can't have 2 routines with the same name, you will need to merge the codes together.
Naive attempt:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, cell As Range
    Set rng = Intersect(Target, Range("C:C"))
    
    If Not rng Is Nothing Then
        Application.EnableEvents = False
        For Each cell In rng
            Cells(cell.Row, "B") = Application.UserName
            Cells(cell.Row, "A") = Format(Date, "dd.mm.yyyy")
        Next cell
    End If
    
    Set rng = Intersect(Target, Range("G:G"))
    If Not rng Is Nothing Then
        Application.EnableEvents = False
        For Each cell In rng
            Cells(cell.Row, "F") = Application.UserName
            Cells(cell.Row, "E") = Format(Date, "dd.mm.yyyy")
        Next cell
    End If
    
    Application.EnableEvents = True
End Sub

However, as you do exactly the same for column C and column G (writing name and date to the 2 cells left of the modified cell(s)), you can simplify the code by using Union to check if cells where modified in column C or column G and use the Offset-function to access the cells to the left:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, cell As Range
    Set rng = Intersect(Target, Union(Range("C:C"), Range("G:G")))
    
    If rng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each cell In rng
        cell.Offset(0, -1) = Application.UserName
        cell.Offset(0, -2) = Format(Date, "dd.mm.yyyy")
    Next cell
    Application.EnableEvents = True
End Sub

CodePudding user response：

This is exactly what I was looking for, for both to work together. I was thinking now how to add to the IF line so that if I delete cell on column C:C or G:G, and they remain blank/empty, to automatically delete the content from columns A and B as well.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Set rng = Intersect(Target, Range("C:C"))

If Not rng Is Nothing Then
    Application.EnableEvents = False
    For Each cell In rng
    If cell.Value = "" Then
        Cells(cell.Row, "B").ClearContents
        Cells(cell.Row, "A").ClearContents
    Else
        Cells(cell.Row, "B") = Application.Username
        Cells(cell.Row, "A") = Format(Date, "dd.mm.yyyy")
    
    End If
    Next cell
End If

Set rng = Intersect(Target, Range("F:F"))
If Not rng Is Nothing Then
    Application.EnableEvents = False
    For Each cell In rng
    If cell.Value = "" Then
        Cells(cell.Row, "E").ClearContents
        Cells(cell.Row, "D").ClearContents
    Else
        Cells(cell.Row, "E") = Application.Username
        Cells(cell.Row, "D") = Format(Date, "dd.mm.yyyy")
    
    End If
    Next cell
End If
       
Application.EnableEvents = True
End Sub

Works like a charm. Thanks FunThomas for your quick help.