VBA Excel: Write timestamp to cell on change of another cell-CodePudding

I want to insert a timestamp (E3) when the status (B3) changes. This should happen for at least 30 more such examples in the worksheet. The code currently works only for one example (Country1). Do you have an idea how this can be implemented?

I already tried different types but it just worked for example "Country 1" not for "Country 1", "Country 2", "Country 3" etc.
When I adjust the code for the range "B3:I3" then I received an adjustment in every 3rd column, example: I add a comment in D3 then a timestamp will be created in H3. That is not what I want. :(

Is there a way to adjust the code so that as soon as a change is made in the Status column (B3;F3;J3etc.), the Timestamp column (E3;I3 etc.) will reflect the time stamp?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:B5"))  
Is Nothing Then Exit Sub  
Application.EnableEvents = False  
Target.Offset(0,3).Value = Now 
Application.EnableEvents = True

CodePudding user response：

Your request is a little unclear, and your table format may not have come across correctly in your post. Your code is written to add the current time to a cell 3 columns away from the target cell. It is dynamic, so if you set

If Intersect(Target, Range("B2:I3"))

You are going to get the value in cell 3 columns offset from the changed cell. If you always want it to update column E, then you can use the target.row property...

Cells(Target.Row,5).Value = Now

...to make the row dynamic, and the column static. Clarify your question if this is not what you're looking for. If country2 is in cell F2, where do you want to write the timestamp?

CodePudding user response：

Please, try the next adapted event. It will calculate how many groups of four columns exists and set a range of their first column intersected with rows 3 to 5. Only for this range the event will be triggered:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastCol As Long, rngCols As Range

    lastCol = Me.cells(2, Me.Columns.count).End(xlToLeft).column 'last column on the second row
    Set rngCols = Me.Range(trigData(Me.Range("B2", Me.cells(2, lastCol)))) 'create the range of the columns for what the event to be triggered
    Set rngCols = Intersect(Me.rows("3:5"), rngCols) 'create the range inside which the change to trigger the event
    If Not Intersect(rngCols, Target) Is Nothing Then
        Application.EnableEvents = False
          Target.Offset(0, 3).Value = Now
        Application.EnableEvents = True
    End If
End Sub

Function trigData(rngCols As Range) As String
    Dim i As Long, strCols As String

    For i = 1 To rngCols.Columns.count Step 4 'iterate from four to four and create the necessary columns string address
        strCols = strCols & "," & rngCols.cells(i).EntireColumn.address
    Next i
    trigData = Mid(strCols, 2) 'Mid eliminates the first (unnecessary) comma...
End Function

The code will be confused if you place on the second row data after the necessary groups of four columns. If necessary, one or two such columns, the code can be adapted to work for a fix number extracting the divided integer (without decimals).

The code assumes that you need to be triggered for the mentioned rows (3 to 5). If you need something different in terms of rows to be affected, you should change Me.rows("3:5") according to your need.

Please, send some feedback after testing it.