VBA Excel 循环与增量行和列

Question

So I'm very new with working with excel's VBA code, and I'm trying to create a 'Date Modified' column for when a value in the previous column was edited for a checklist at work. I've done this once before for another checklist, but I did it the old-fashioned way since it was not a very long checklist. But for this application, that is not efficient at all since this list will be ongoing. I've cobbled together this code using other examples from people in the community, but I can't figure out where the source of the error is coming from. It's saying that there is a compile error 'Do without Loop'. From my understanding from other posts, it thinks that the 'If' statement is not being closed, but I have used an 'End If' and there is only one 'If' statement in my code. I need it to be alternating columns from the 6th column onward and then repeating every row. Any help is much appreciated!

Sub Worksheet_Change(ByVal Target As Range)
Dim ColCount As Long
    ColCount = 6
Dim RowCount As Long
    RowCount = 2
Dim iCol As Long
    iCol = 7
Dim iRow As Long
    iRow = 2
Do While RowCount < 2
    Do While ColCount < 6
        Do While iCol < 7
            Do While iRow < 2
            
                If Target.Column = ColCount And Target.Row = RowCount Then
                    ActiveSheet.Cells(iRow, iCol).Value = Format(Date, "mm/dd/yyyy")
                End If
                
                RowCount = RowCount + 1
                ColCount = ColCount + 2
                iCol = iCol + 2
                iRow = iRow + 1

Loop

End Sub

Answer 1

Simpler approach:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, c As Range
    
    Set rng = Application.Intersect(Target, Me.Range("F:F,H:H,J:J")) 'adjust to suit...
    If rng Is Nothing Then Exit Sub 'no updates in monitored range
    
    For Each c In rng.Cells
        c.Offset(0, 1).Value = Format(Date, "mm/dd/yyyy")
    Next c

End Sub

Answer 2

Add a Datestamp Next to Every Other Column

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    AddDateStamp Target
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Adds a datestamp next to every other column.
' Calls:        'RefWsColumnsFirstRow','RefRangeNthColumns'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub AddDateStamp(ByVal Target As Range)
    Const ProcName As String = "AddDateStamp"
    On Error GoTo ClearError
    
    Const Cols As String = "F:BA"
    Const fRow As Long = 2 ' '2' excludes headers in first row
    Const cStep As Long = 2
    Const dcOffset As Long = 1
    Const ddFormat As String = "mm/dd/yy" ' "mm/dd/yy hh:mm:ss" '
    Const DoExcludeFirstColumn As Boolean = False ' 'False: F, H, J... AZ'
    
    Dim crg As Range ' 'F2:BA1048576' ('F2:BA65536' for older versions)
    Set crg = RefWsColumnsFirstRow(Target.Worksheet, Cols, fRow)
    Dim srg As Range ' 'F2:F1048576, H2:H..., J2:J..., ... , AZ2:AZ1048576'
    Set srg = RefRangeNthColumns(crg, cStep, DoExcludeFirstColumn)

    Dim sirg As Range: Set sirg = Intersect(srg, Target)
    If sirg Is Nothing Then Exit Sub
    
    Dim drg As Range: Set drg = sirg.Offset(, dcOffset)
    
    Application.EnableEvents = False
    drg.Value = Format(Date, ddFormat) ' 'Now' (instead of 'Date')

SafeExit:
    
    If Not Application.EnableEvents Then Application.EnableEvents = True
    
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume SafeExit
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to a columns ('ColumnsAddress') range
'               from the first row ('FirstRow') to the bottom-most
'               worksheet's ('ws') row.
' Example:      'If ColumnsAddress = "B:E" and FirstRow = 5 Then "B5:E1048576"'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefWsColumnsFirstRow( _
    ByVal ws As Worksheet, _
    Optional ByVal ColumnsAddress As String = "A:A", _
    Optional ByVal FirstRow As Long = 1) _
As Range
    Const ProcName As String = "RefWsColumnsFirstRow"
    On Error GoTo ClearError

    Set RefWsColumnsFirstRow = ws.Columns(ColumnsAddress) _
        .Resize(ws.Rows.Count - FirstRow + 1).Offset(FirstRow - 1)

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference combined from every n-th ('NthStep') column
'               of a range ('rg').
'               The default value of 'DoExcludeFirstColumn' is 'False' i.e.
'               e.g. if 'NthStep' = 2 then the columns are 1, 3, 5...etc.;
'               otherwise, the columns are 2, 4, 6...etc.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefRangeNthColumns( _
    ByVal rg As Range, _
    Optional ByVal NthStep As Long = 1, _
    Optional ByVal DoExcludeFirstColumn As Boolean = False) _
As Range
    Const ProcName As String = "RefRangeNthColumns"
    On Error GoTo ClearError
    
    Dim Col1 As Long, ColGT As Long, Col2 As Long
    If DoExcludeFirstColumn Then
        Col1 = NthStep: ColGT = 2 * NthStep - 1: Col2 = 2 * NthStep
    Else
        Col1 = 1: ColGT = NthStep: Col2 = 1 + NthStep
    End If
        
    Dim crg As Range: Set crg = rg.Columns(Col1)
    Dim scCount As Long: scCount = rg.Columns.Count
    
    Dim c As Long
    If scCount > ColGT Then
        For c = Col2 To scCount Step NthStep
            Set crg = Union(crg, rg.Columns(c))
        Next c
    End If

    Set RefRangeNthColumns = crg

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function