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

Question

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?

Answer 1

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

Answer 2

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.