Enhance existing VBA for multiple loops

[ItalianPlatinum]

Hello - looking for a way to expand my loop to also run off another loop. What I mean is it runs for all Items for each date. Currently I have it loop for all dates as seen below and want to add items. For example:

Dates and Items would like to be amendable based off another range in another sheet.

Date 5/5/21; run for Item A, B, C then
Date 5/6/21: run for Item A, B, C and so forth

Option Explicit
Sub RUN_DATE_LOOP()
Dim Dates As Date
Dim i As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Call Clear

Sheets("Sec").Range("Items") = A

' Run Dates loop
i = 1
Do Until Sheets("Date Loop").Range("Dates").Offset(i, 0) = ""
Dates = Sheets("Date Loop").Range("Dates").Offset(i, 0)
Sheets("Sec").Range(REQDATE") = Dates
Call Sec2
i = i + 1
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[offthelip]

One thing to be careful of when you start introdicing multiple loops is your code will start taking a long time unless you are careful about how often you are accessing the worksheet. You current code access the worksheet on 3 out of the 5 lines. so this will get slow is you you other loop is a long loop . It is very easy to speed this up.I have rewritten your code using variant arrays to load all th dates into just once so when you put loop round the outside it will still be very fast.

Dim item
Sub test()

'Find the column and row of the Dates names range
colno = Sheets("Dates Loop").Range("Dates").Column
rowno = Sheets("Dates Loop").Range("Dates").Row
' find the last row with data in that column
lastrow = Cells(Rows.Count, colno).End(xlUp).Row
' load all the dats into and array
alldates = Range(Cells(rowno, colno), Cells(lastrow, colno))
items = Array("A", "B", "C")

For j = 0 To UBound(items, 1)
    item = items(j)
    For i = 1 To UBound(alldates, 1)
    Sheets("Sec").Range(REQDATE") = alldates(i,1)
    Call sec2
    Next i
Next j
End Sub

 

[ItalianPlatinum]

My items could change. i see that is hard coded. is that possible to also make it sort of a loop based off another sheet? usually it is always the same 4 A-D; but at times it may not

 

[offthelip]

Yes of course it is just load items from a range
e.g

Items=Range(("K3:k33")

You will need to change this line though because the array becomes two dimensional when you load it from a range:

item = items(j,1)

 

[ItalianPlatinum]

Not quite working maybe you can see what I am doing wrong:

Sub RUN_DATE_LOOP2()
Dim item
Dim colno
Dim rowno
Dim lastrow
Dim Alldates
Dim j As Long
Dim i As Long
Dim Dates As Date

'Find the column and row of the Dates names range
colno = Sheets("Dates Loop").Range("Dates").Column
rowno = Sheets("Dates Loop").Range("Dates").row

' find the last row with data in that column
lastrow = Cells(rows.count, colno).End(xlUp).row

' load all the dats into and array
Alldates = Range(Cells(rowno, colno), Cells(lastrow, colno))
Sheets("Sec").Range("ITEM") = Sheets("ITEM").Range("A2:A5")

For j = 0 To UBound(ITEMS, 1)
    Sheets("Sec").Range("ITEM") = ITEM(j, 1)
    For i = 1 To UBound(Alldates, 1)
    Sheets("Sec").Range("REQDATE") = Alldates(i, 1)
    Call Sec2
    Next i
Next j
End Sub

says type mismatch here...For j = 0 To UBound(Items, 1)

 

[offthelip]

It is because you haven't loaded the variant array ITEMS with anything, it is defined but blank so it defaults to a single variant not an array. If you look back at the code I wrote, I loaded it with letters to start with :

items = Array("A", "B", "C")

you asked whether it could be loaded from the worksheet which is easily done with this sort of code :

Items=Range(("K3:k33")

so you need to load ITEMS with the "items" that you want to go round in the loop
Note if the items are in one row so that you are loading a range like:

Items=Range(("A3:D3")

you need to change these two lines

For j = 0 To UBound(ITEMS, 2)
    Sheets("Sec").Range("ITEM") = ITEM(1,j)

 

[ItalianPlatinum]

Ok i defined those on the range already. it was missing the quotations I believe that is why it failed i corrected that. now it is getting stuck here saying. So got a little further

For i = 1 To UBound(Alldates, 1) expected array

 

[ItalianPlatinum]

Sub RUN_DATE_LOOP2()
Dim Items
Dim colno
Dim rowno
Dim lastrow
Dim Alldates As Date
Dim j As Long
Dim i As Long
Dim Dates As Date

'Find the column and row of the Dates names range
colno = Sheets("Date Loop").Range("Dates").Column
rowno = Sheets("Date Loop").Range("Dates").row

' find the last row with data in that column
lastrow = Cells(rows.count, colno).End(xlUp).row

' load all the dates into and array
Alldates = Range(Cells(rowno, colno), Cells(lastrow, colno))
Views = Sheets("Items").Range("A2:A5")
Sheets("Sec").Range("S_Items") = Sheets("Items").Range("A2:A5")

For j = 0 To UBound(Views, 2)
    Sheets("Se").Range("S_Items") = Views(1, j)
    For i = 1 To UBound(Alldates, 1)
    Sheets("Sec").Range("REQDATE") = Alldates(i, 1)
    Call Sec2
    Next i
Next j
End Sub

here is my full code. items are on its own sheet in the workbook called items (A2:A5).

 

[offthelip]

my mistake try this:
'Find the column and row of the Dates names range
colno = Sheets("Date Loop").Range("Dates").Column
rowno = Sheets("Date Loop").Range("Dates").Row
With Sheets("Date Loop")
' find the last row with data in that column
lastrow = .Cells(Rows.Count, colno).End(xlUp).Row

' load all the dates into and array
Alldates = .Range(.Cells(rowno, colno), .Cells(lastrow, colno))
End With
For j = 0 To UBound(Views, 1)
Sheets("Se").Range("S_Items") = Views(j, 1)
For i = 1 To UBound(Alldates, 1)
Sheets("Sec").Range("REQDATE") = Alldates(i, 1)
Call Sec2
Next i
End Sub

 

[offthelip]

whoops sorry a cut and paste error I left two lines out of the last solution use this:

'Find the column and row of the Dates names range
colno = Sheets("Date Loop").Range("Dates").Column
rowno = Sheets("Date Loop").Range("Dates").Row
With Sheets("Date Loop")
' find the last row with data in that column
lastrow = .Cells(Rows.Count, colno).End(xlUp).Row

' load all the dates into and array
Alldates = .Range(.Cells(rowno, colno), .Cells(lastrow, colno))
Views = Sheets("Items").Range("A2:A5")
Sheets("Sec").Range("S_Items") = Sheets("Items").Range("A2:A5")
End With
For j = 0 To UBound(Views, 1)
    Sheets("Se").Range("S_Items") = Views(j, 1)
    For i = 1 To UBound(Alldates, 1)
    Sheets("Sec").Range("REQDATE") = Alldates(i, 1)
    Call Sec2
    Next i
End Sub