I have little experience with VBA code and I am trying to get this code to repeat for rows 2-100. The issue I have found vs other codes that repeat in rows is that mine has multiple end arguments and I'm not sure how to account for this. Any help is greatly appreciated.

Private Sub Worksheet_SelectionChange2(ByVal Target As Range)

    a = Date
    b = 2

    If Cells(b, 3).Value <> Blank Then
        If Cells(b, 2).Value = Blank Then
            Cells(b, 2).Value = a
            Exit Sub
        End If

        If Cells(b, 2).Value < a Then
            Exit Sub
        End If
        Cells(b, 2).Value = a
    End If

End Sub

This is what I'm working with. I tried to make the cell reference a variable that I could count up but whatever I tried it didn't work.

Edit: Sorry for lack of clarification. The code is supposed to put today's date in B2 when C2 goes from being empty to having anything in it. It also prevents the date from being changed if there is already a date there, even if C2 is cleared. I am trying to extend it so that rather than just C2 and B2 it is C2-C100 and then corresponding B2-B100.

Edit 2: C2 is being changed by a manual input. The purpose is to have someone input data into C2 (and the rest of the row) and for the date to be automatically entered and locked so they cannot change it and I can see when the data was inputted.

CodePudding user response：

A Worksheet Change (Timestamp)

• This will only work if the values in column C are modified manually i.e. by manually entering, by copy/pasting, and by writing via VBA.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo ClearError
    
    Const fRow As Long = 2
    Const sCol As String = "C"
    Const dCol As String = "B"
    
    Dim scrg As Range: Set scrg = Columns(sCol).Resize(Rows.Count - fRow   1)
    
    Dim srg As Range: Set srg = Intersect(scrg, Target)
    If srg Is Nothing Then Exit Sub
    
    Dim drg As Range
    Dim dCell As Range
    Dim sCell As Range
    
    For Each sCell In srg.Cells
        Set dCell = sCell.EntireRow.Columns(dCol)
        If Len(CStr(dCell.Value)) = 0 Then
            If drg Is Nothing Then
                Set drg = dCell
            Else
                Set drg = Union(drg, dCell)
            End If
        End If
    Next sCell
    
    ' All cells already contain a date.
    If drg Is Nothing Then Exit Sub
    
    Dim dDate As Date: dDate = Now ' after prooving that it works, use 'Date'
    
    ' To prevent retriggering this event and any other event while writing.
    Application.EnableEvents = False
    
    ' Write in one go.
    drg.Value = dDate
    
SafeExit:
    ' Enable events 'at any cost'.
    If Not Application.EnableEvents Then Application.EnableEvents = True

    Exit Sub

ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit

End Sub