Adjust Current VBA for Date Loop move into VBA

[ItalianPlatinum]

Hello - I am looking to modify existing code I have been leveraging where I have been defining the range of dates in a separate sheet and I want to move to a more automated approach where it loops through a START and a END within the code. Those dates I already have defined in other codes as set ranges. Any help is appreciated.

Start date = RUNDATE
End date = FFWD

The code currently runs Date 1 with view A, Date 1 with view B then until view is empty then moves to Date 2 and so on.

Existing VBA:

Option Explicit
Sub RUN_DATE_LOOP()
Dim Views
Dim colno
Dim rowno
Dim lastrow
Dim alldates
Dim j As Long
Dim i As Long
Dim Dates As Date

With Sheets("Date Loop")
' find the last row with data in that column
lastrow = .Cells(rows.count, "A").End(xlUp).row
' load all the dates into and array
alldates = .Range(.Cells(2, 1), .Cells(lastrow, 1))
Views = Sheets("Views").Range("A2:A5")
End With
For j = 1 To UBound(Views, 1)
    Sheets("Sec").Range("View") = Views(j, 1)
    For i = 1 To UBound(alldates, 1)
    Sheets("Sec").Range("REQDATE") = alldates(i, 1)
    Call Sec2
    Next i
Next j

 

[NateSC]

I assume from your description that you want to limit the "i" loop through "alldates" based on your values for RUNDATE and FFWD. I pulled out just part of your code and came up with the following that you should be able to adapt to your code. I stole the function from another post. Apparently a loop like this is much quicker than using the Index function. The only issue I see could be making sure you have your data types match up properly. Let me know if you need help integrating this idea into your code:

Sub MyTest()

    ' Where you specify or read your start and end dates
    RUNDATE = CDate("1/4/2023")
    FFWD = CDate("1/8/2023")
    
    With Sheets("Sheet3")
        ' find the last row with data in that column
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        ' load all the dates into and array
        alldates = .Range(.Cells(2, 1), .Cells(lastrow, 1))
        
    End With
    
    StartI = FindIndex(alldates, RUNDATE)
    EndI = FindIndex(alldates, FFWD)
    
    For i = StartI To EndI
        Sheets("Sheet3").Cells(i + 1, 3).value = alldates(i, 1)
    Next i

End Sub

Function FindIndex(arr, val)
    Dim r As Long
    For r = 1 To UBound(arr, 1)
        If Not IsError(Application.Match(val, Application.Index(arr, r, 0), 0)) Then
            FindIndex = r
            Exit Function
        End If
    Next r
End Function

 

[ItalianPlatinum]

So that loops the days only? I would then need to find a way to loop the views in coordination of the days to run the call sub. Cause currently it goes like this. Date A, View 1, Run sec 2, Date A, View 2, Run Sec2....etc.

 

[NateSC]

Sorry. I was just trying to show you the pieces. I left my hardcoded values for RUNDATE and FFWD, but you will want to modify those to look at your sheet or form. Putting it all together, it should look something like this:

Option Explicit

Sub RUN_DATE_LOOP()

Dim Views
Dim colno
Dim rowno
Dim lastrow
Dim alldates
Dim j As Long
Dim i As Long
Dim Dates As Date

    ' Where you specify or read your start and end dates !!! UPDATE THESE LINES BELOW
    RUNDATE = CDate("1/4/2023")
    FFWD = CDate("1/8/2023")

    With Sheets("Date Loop")
        ' find the last row with data in that column
        lastrow = .Cells(rows.count, "A").End(xlUp).row
        ' load all the dates into and array
        alldates = .Range(.Cells(2, 1), .Cells(lastrow, 1))
        Views = Sheets("Views").Range("A2:A5")
    End With
    
    Dim StartI as Integer
    Dim EndI as Integer
    StartI = FindIndex(alldates, RUNDATE)
    EndI = FindIndex(alldates, FFWD)
    
    For j = 1 To UBound(Views, 1)
        Sheets("Sec").Range("View") = Views(j, 1)
        For i = StartI To EndI
            Sheets("Sec").Range("REQDATE") = alldates(i, 1)
            Call Sec2
        Next i
    Next j

    'DO OTHER STUFF
    
End Sub

Function FindIndex(arr, val)
    Dim r As Long
    For r = 1 To UBound(arr, 1)
        If Not IsError(Application.Match(val, Application.Index(arr, r, 0), 0)) Then
            FindIndex = r
            Exit Function
        End If
    Next r
End Function

 

[ItalianPlatinum]

Doesnt seem to be working what would the purpose of this be? that was the old code where i listed all the dates in a sheet. I would assume that would now not be needed seeing we moving to a start and end date of rundate and ffwd. But I could have it wrong.

    With Sheets("Date Loop")
        ' find the last row with data in that column
        lastrow = .Cells(rows.count, "A").End(xlUp).row
        ' load all the dates into and array
        alldates = .Range(.Cells(2, 1), .Cells(lastrow, 1))
        Views = Sheets("Views").Range("A2:A5")
    End With

 

[NateSC]

What exactly is the problem or error you are seeing?
The code you mention above was your original code. I did not modify that. It should put all the values from Column A starting from row 2 in "alldates". You DO need this code because the loop is going through this array and comparing each value against Sheets("Sec").Range("REQDATE").

 

[ItalianPlatinum]

What exactly is the problem or error you are seeing?
The code you mention above was your original code. I did not modify that. It should put all the values from Column A starting from row 2 in "alldates". You DO need this code because the loop is going through this array and comparing each value against Sheets("Sec").Range("REQDATE").

The sheet doesn't exist because I am trying to solution within VBA setting the dates and avoiding to list the dates in that sheet. So as expected and cannot locate the sheet. I can add that sheet back but it kind of goes against the end goal. You know what I mean?

Hello - I am looking to modify existing code I have been leveraging where I have been defining the range of dates in a separate sheet and I want to move to a more automated approach where it loops through a START and a END within the code. Those dates I already have defined in other codes as set ranges. Any help is appreciated.