Enhance existing VBA for multiple loops

ItalianPlatinum

Active Member
Joined
Mar 23, 2017
Messages
434
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
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

VBA Code:
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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,851
Office Version
  1. 2010
Platform
  1. Windows
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.
VBA Code:
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

Active Member
Joined
Mar 23, 2017
Messages
434
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,851
Office Version
  1. 2010
Platform
  1. Windows
Yes of course it is just load items from a range
e.g
VBA Code:
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:
VBA Code:
item = items(j,1)
 

ItalianPlatinum

Active Member
Joined
Mar 23, 2017
Messages
434
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

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

VBA Code:
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

Well-known Member
Joined
Dec 23, 2017
Messages
1,851
Office Version
  1. 2010
Platform
  1. Windows
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 :
VBA Code:
items = Array("A", "B", "C")
you asked whether it could be loaded from the worksheet which is easily done with this sort of code :
VBA 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:
VBA Code:
Items=Range(("A3:D3")
you need to change these two lines
VBA Code:
For j = 0 To UBound(ITEMS, 2)
    Sheets("Sec").Range("ITEM") = ITEM(1,j)
 

ItalianPlatinum

Active Member
Joined
Mar 23, 2017
Messages
434
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

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

Active Member
Joined
Mar 23, 2017
Messages
434
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
VBA Code:
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).
 
Last edited:

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,851
Office Version
  1. 2010
Platform
  1. Windows
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
 
Last edited:

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,851
Office Version
  1. 2010
Platform
  1. Windows
whoops sorry a cut and paste error I left two lines out of the last solution use this:
VBA Code:
'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
 

Watch MrExcel Video

Forum statistics

Threads
1,132,899
Messages
5,655,861
Members
418,248
Latest member
JinxedCaspa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top