VBA Excel Loop with Incremental Rows and Columns - 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