VBA Excel Loop with Incremental Rows and Columns

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

You give each variable a value and then want the loop to run while the variables are below each respective value. Ex. if RowCount = 2 then Do While RowCount < 2 exits right away since RowCount is not smaller than 2. You are also missing 3 Loop statements — cybernetic.nomad
– cybernetic.nomad, Commented Dec 23, 2021 at 18:45
You have four Do and only one Loop - they need to be matched pairs — Tim Williams
– Tim Williams, Commented Dec 23, 2021 at 18:46

Tim Williams · Accepted Answer · 2021-12-23 18:54:58Z

4

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

answered Dec 23, 2021 at 18:54

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

enewman10909 Over a year ago

It won't work past column 'K', I need it to be able to carry down to column 'BA'. My apologies, I left that bit out.

Tim Williams Over a year ago

That's what "adjust to suit..." means?

enewman10909 Over a year ago

I should've asked how to adjust it then, because I don't really understand what your code is doing.

Tim Williams Over a year ago

It checks if any updated cells are in Me.Range("F:F,H:H,J:J"), so if you need to check additional columns you can expand that range address eg: Me.Range("F:F,H:H,J:J,I:I,L:L") etc

VBasic2008 · Accepted Answer · 2021-12-25 00:44:33Z

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

Collectives™ on Stack Overflow

VBA Excel Loop with Incremental Rows and Columns

2 Answers 2

4 Comments

Add a Datestamp Next to Every Other Column

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

Add a Datestamp Next to Every Other Column

Comments

Your Answer

Sign up or log in

Post as a guest

Related