Loop through Multiple Worksheets, with autofilter, for different Criteria

C

Cooliozar

New Member
Joined
Jun 1, 2018
Messages
12
I've searched several forums over the last few days and have been unable to find exactly what I'm trying to do. Apologies if I missed it somewhere in this forum.

Currently, I have a functioning macro that will autofilter each worksheet for the specified values from the main "input" worksheet however, they are each contained within their own "with" statement. There are currently 9 separate "with" statements (1 for each worksheet) and I'm needing to expand this macro to possibly 40 different worksheets. Each worksheet has different values in different cloumns that need to be pulled based on filtered criteria. The question is, can I use VBA to combine these calls to each worksheet in a "for loop" or some other way? If so, how?

The following represents code I currently have with values changed for simplicity:

Code: 
Sub Calculations()

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
For i = 3 To ActiveWorkbook.Worksheets.Count
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
End If
Next i

Dim rInput1 As Range, rInput2 As Range, rInput3 As Range, rInput4 As Range, rInput5 As Range, rInput6 As Range, rInput7 As Range, rInput8 As Range
Dim rRng1 As Range, rRng2 As Range, rRng3 As Range, rRng4 As Range, rRng5 As Range, rRng6 As Range, rRng7 As Range, rRng8 As Range, rRng9 As Range
Dim vReturn1 As Double, vReturn2 As Double, vReturn3 As Double, vReturn4 As Double, vReturn5 As Double, vReturn6 As Double, vReturn7 As Double, vReturn8 As Double, vReturn9 As Double

Set rInput1= Worksheets("Input Sheet").Range("C7")
Set rInput2 = Worksheets("Input Sheet").Range("C8")
Set rInput3 = Worksheets("Input Sheet).Range("C9")
Set rInput4 = Worksheets("Input Sheet").Range("C10")
Set rInput5 = Worksheets("Input Sheet).Range("C11")
Set rInput6 = Worksheets("Input Sheet").Range("C12")
Set rInput7 = Worksheets("Input Sheet").Range("C13")
Set rInput8 = Worksheets("Input Sheet").Range("C14")
 
Set rRng1 = Worksheets("WORKSHEET1").Range("A1:K5")
Set rRng2 = Worksheets("WORKSHEET2").Range("A1:N13")
Set rRng3 = Worksheets("WORKSHEET3").Range("A1:N117")
Set rRng4 = Worksheets("WORKSHEET4").Range("A1:O5")
Set rRng5 = Worksheets("WORKSHEET5").Range("A1:O3")
Set rRng6 = Worksheets("WORKSHEET6).Range("A1:L598")
Set rRng7 = Worksheets("WORKSHEET7").Range("A1:N76")
Set rRng8 = Worksheets("WORKSHEET8").Range("A1:N211")
Set rRng9 = Worksheets("WORKSHEET9").Range("A1:P111")
 
    
With rRng1
    .AutoFilter Field:=1, Criteria1:=rInput1.Value
    
    .AutoFilter Field:=3, Criteria1:="<=" & rInput3
    .AutoFilter Field:=4, Criteria1:=">=" & rInput3
    
    .AutoFilter Field:=5, Criteria1:="<=" & rInput2
    .AutoFilter Field:=6, Criteria1:=">=" & rInput2
    
     .AutoFilter Field:=5, Criteria1:="<=" & rInput4
    .AutoFilter Field:=6, Criteria1:=">=" & rInput4
    
     .AutoFilter Field:=10, Criteria1:="<=" & rInput5
    .AutoFilter Field:=11, Criteria1:=">=" & rInput5
    
    Worksheets("WORKSHEET1").Activate
    
    Range("I2", Cells(Rows.Count, "I").End(xlUp + 1)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
    
    vReturn3 = Selection.Value

End With


With rRng2
    .AutoFilter Field:=1, Criteria1:=rInput1.Value
    
    .AutoFilter Field:=2, Criteria1:="<=" & rInput7
    .AutoFilter Field:=10, Criteria1:=">=" & rInput7
    
    Worksheets("WORKSHEET2").Activate
    
    Range("L2", Cells(Rows.Count, "L").End(xlUp + 1)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
    
    vReturn9 = Selection.Value
    
End With

This method continues on until all 9 worksheets have been filtered for (and selected) different criteria, while rInput1 always remains the 1st autofilter as well as the 1st "Field".  The macro ends with populating return values into specific cells on the Input Sheet and then a calculation is done and presented into a cell and the macro ends with the following:


Worksheets("Input Sheet").Activate

Application.EnableEvents = True

End Sub

Since all the criteria varies within each rRng I don't konw how to roll up this logic into a single loop.

I appreciate any help that anyone can provide. Please let me know if I need to provide more information. Thanks!

Microsoft Misual Basic for Applications 7.1
Excel 2013
Windows 7 SP1
X64-based PC
Quad 2.40 GHz Intel Core i5-6300U
8 GB DDR
 
Last edited by a moderator:
Sort by date Sort by votes
Ok, try this
Code: 
Sub CVOSCalc()
   Dim RngAry(8) As Range, CritAry(8) As Variant, vReturn(8) As Double
   Dim InAry(1 To 8) As Variant
   Dim i As Long, j As Long
   Dim Rngadd As Variant, ColAry As Variant
  
   ColAry = Array(9, 12, 11, 13, 13, 11, 7, 11, 13)                                  'The column numbers for the vReturn value
   Rngadd = Array("ACQ_FEE_RANGE", "A1:K5", "DLR_FLAT_FEE", "A1:N13", "FINC_AMT_RT_ADJ", "A1:N117", "FS_PART_PCT", "A1:O5", "FS_PART_SPLIT_PCT", "A1:O3", "LTV_SCORE_RT", "A1:L598", "RT_SHEET", "A1:N76", "TERM_PRICE_ADJ", "A1:N211", "VEH_AGE_ADJ", "A1:P111")   'The sheet ranges for the filter
   
   With Application
       .EnableEvents = False
       .ScreenUpdating = False
   End With
   For i = 0 To ActiveWorkbook.Worksheets.Count
      If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
          ActiveSheet.ShowAllData
      End If
   Next i
 
   For i = 1 To 8
      InAry(i) = Sheets("CVOS Pricing Calculator").Range("C" & i + 6).Value
   Next i
'Range 1
   CritAry(0) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 10, "<=" & InAry(5), 11, ">=" & InAry(5))
'Range 2
   CritAry(1) = Array(1, InAry(1), 2, "<=" & InAry(7), 10, ">=" & InAry(7))
'Range 3
   CritAry(2) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 7, "<=" & InAry(7), 8, ">=" & InAry(7), 13, "<=" & InAry(5), 14, ">=" & InAry(5))
'Range 4
   CritAry(3) = Array(1, InAry(1), 5, "<=" & InAry(3), 6, ">=" & InAry(3), 7, "<=" & InAry(2), 8, ">=" & InAry(2), 7, "<=" & InAry(4), 8, ">=" & InAry(4), 14, "<=" & InAry(5), 15, ">=" & InAry(5))
'Range 5
   CritAry(4) = Array(1, InAry(1))
'Range 6
   CritAry(5) = Array(1, InAry(1), 3, "<=" & InAry(5), 4, ">=" & InAry(5), 5, "<=" & InAry(3), 6, ">=" & InAry(3), 7, "<=" & InAry(2), 8, ">=" & InAry(2), 7, "<=" & InAry(4), 8, ">=" & InAry(4))
'Range 7
   CritAry(6) = Array(1, InAry(1), 3, "<=" & InAry(3), 6, ">=" & InAry(3), 11, "<=" & InAry(2), 12, ">=" & InAry(2), 11, "<=" & InAry(4), 12, ">=" & InAry(4), 13, "<=" & InAry(5), 14, ">=" & InAry(5))
'Range 8
   CritAry(7) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 7, "<=" & InAry(8), 8, ">=" & InAry(8))
'Range 9
   CritAry(8) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 9, "<=" & InAry(6), 10, ">=" & InAry(6))
   
   For i = 0 To UBound(Rngadd) Step 2
         Set RngAry(i) = Sheets(Rngadd(i)).Range(Rngadd(i + 1))
   Next i
   
   For i = 0 To UBound(RngAry)
      For j = 0 To UBound(CritAry(i)) Step 2
         RngAry(i).AutoFilter Field:=CritAry(i)(j), Criteria1:=CritAry(i)(j + 1)
      Next j
      With RngAry(i).Parent
         vReturn(i) = .Range(.Cells(2, ColAry(i)), .Cells(Rows.Count, ColAry(i)).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1)
      End With
   Next i
   

Range("C18").Value = vReturn(0)
Range("C19").Value = vRetur(1)
Range("C20").Value = vReturn(2)
Range("C21").Value = vReturn(3)
Range("c22").Value = vReturn(4)
Range("C23").Formula = (vReturn(5) / 100)
Range("C24").Value = vReturn(6)
Range("C25").Value = vReturn(7)
Range("C26").Value = vReturn(8)
Range("D7").Formula = "=C18+C21+C23+C24"
Range("D7:G14") = Range("D7")  ' For Merged Cells
Range("D18").Formula = "=C18+C21+C23+C24"
Range("D18:G26") = Range("D18") ' For Merged Cells
   Worksheets("Input Sheet").Activate
   
   Application.EnableEvents = True
End Sub
Not sure which of the vreturns goes where but I've put vreturn for sheet 3 in C18, vreturn for sheet4 in C19 etc
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Well, I'm still going at it. Currently getting a subscript out of range error and have no idea why. I know this usually means the code is trying to call something I've referenced but can't find it. In this case I'm getting it at
Set RngAry(i) = Sheets(Rngadd(i)).Range(Rngadd(i + 1))

Where Rngadd(i)) is "RT_SHEET" and .range(Rngadd(i + 1) is "A1:N76". It loops through each previous worksheet just fine but stops with this one.

I've verified multiple times that the spelling is correct and the range is correct and the references are correct.

Also, can you explain why you have the Step 2 in the For/Next loop as well as the i + 1 in the Set statement. I've read what the Step does but I'm not understanding why it's needed in my example.
 
Upvote 0
Firstly select the RT_SHEET & run this
Code: 
Sub chk()
 MsgBox "|" & ActiveSheet.Name & "|"
End Sub
The message box should show |RT_SHEET| if it doesn't there is a problem with the sheet name.

Secondly the step 2 means that i increments by 2 for each loop. So Rngadd(i) will always be the sheet name (ie element 0 then 2 then 4) & rngadd(i+1) will be the address associated with that sheet (element 1 then 3 then 5)
 
Upvote 0
Ok, that shows |RT_SHEET|

I went ahead and ran that against every sheet in the book and they all return the expected name.

Thanks for the explanation on Step 2 and i + 1.

What's the next step to troubleshoot the code since it's returning the expected sheet? Could it have anything to do with the DIMs? Using Option base 1 or not? This confused me originally but I believe I have those correct.
 
Upvote 0
Ok, my mistake try this
Code: 
Sub CVOSCalc()
   Dim RngAry(8) As Range, CritAry(8) As Variant, vReturn(8) As Double
   Dim InAry(1 To 8) As Variant
   Dim i As Long, j As Long
   Dim rngadd As Variant, ColAry As Variant
  
   ColAry = Array(9, 12, 11, 13, 13, 11, 7, 11, 13)                                  'The column numbers for the vReturn value
   rngadd = Array("ACQ_FEE_RANGE", "A1:K5", "DLR_FLAT_FEE", "A1:N13", "FINC_AMT_RT_ADJ", "A1:N117", "FS_PART_PCT", "A1:O5", "FS_PART_SPLIT_PCT", "A1:O3", "LTV_SCORE_RT", "A1:L598", "RT_SHEET", "A1:N76", "TERM_PRICE_ADJ", "A1:N211", "VEH_AGE_ADJ", "A1:P111")   'The sheet ranges for the filter
   
   With Application
       .EnableEvents = False
       .ScreenUpdating = False
   End With
  [COLOR=#0000ff] For i = 1 To ActiveWorkbook.Worksheets.Count
      If (Sheets(i).AutoFilterMode And Sheets(i).FilterMode) Or Sheets(i).FilterMode Then
          Sheets(i).ShowAllData
      End If
   Next i[/COLOR]
 
   For i = 1 To 8
      InAry(i) = Sheets("CVOS Pricing Calculator").Range("C" & i + 6).Value
   Next i
'Range 1
   CritAry(0) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 10, "<=" & InAry(5), 11, ">=" & InAry(5))
'Range 2
   CritAry(1) = Array(1, InAry(1), 2, "<=" & InAry(7), 10, ">=" & InAry(7))
'Range 3
   CritAry(2) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 7, "<=" & InAry(7), 8, ">=" & InAry(7), 13, "<=" & InAry(5), 14, ">=" & InAry(5))
'Range 4
   CritAry(3) = Array(1, InAry(1), 5, "<=" & InAry(3), 6, ">=" & InAry(3), 7, "<=" & InAry(2), 8, ">=" & InAry(2), 7, "<=" & InAry(4), 8, ">=" & InAry(4), 14, "<=" & InAry(5), 15, ">=" & InAry(5))
'Range 5
   CritAry(4) = Array(1, InAry(1))
'Range 6
   CritAry(5) = Array(1, InAry(1), 3, "<=" & InAry(5), 4, ">=" & InAry(5), 5, "<=" & InAry(3), 6, ">=" & InAry(3), 7, "<=" & InAry(2), 8, ">=" & InAry(2), 7, "<=" & InAry(4), 8, ">=" & InAry(4))
'Range 7
   CritAry(6) = Array(1, InAry(1), 3, "<=" & InAry(3), 6, ">=" & InAry(3), 11, "<=" & InAry(2), 12, ">=" & InAry(2), 11, "<=" & InAry(4), 12, ">=" & InAry(4), 13, "<=" & InAry(5), 14, ">=" & InAry(5))
'Range 8
   CritAry(7) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 7, "<=" & InAry(8), 8, ">=" & InAry(8))
'Range 9
   CritAry(8) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3), 5, "<=" & InAry(2), 6, ">=" & InAry(2), 5, "<=" & InAry(4), 6, ">=" & InAry(4), 9, "<=" & InAry(6), 10, ">=" & InAry(6))
   
   For i = 0 To UBound(rngadd) Step 2
         Set RngAry([COLOR=#ff0000]i / 2[/COLOR]) = Sheets(rngadd(i)).Range(rngadd(i + 1))
   Next i
   
   For i = 0 To UBound(RngAry)
      For j = 0 To UBound(CritAry(i)) Step 2
         RngAry(i).AutoFilter Field:=CritAry(i)(j), Criteria1:=CritAry(i)(j + 1)
      Next j
      With RngAry(i).Parent
         vReturn(i) = .Range(.Cells(2, ColAry(i)), .Cells(Rows.Count, ColAry(i)).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1)
      End With
   Next i
   

Range("C18").Value = vReturn(0)
Range("C19").Value = vReturn(1)
Range("C20").Value = vReturn(2)
Range("C21").Value = vReturn(3)
Range("c22").Value = vReturn(4)
Range("C23").Formula = (vReturn(5) / 100)
Range("C24").Value = vReturn(6)
Range("C25").Value = vReturn(7)
Range("C26").Value = vReturn(8)
Range("D7").Formula = "=C18+C21+C23+C24"
Range("D7:G14") = Range("D7")  ' For Merged Cells
Range("D18").Formula = "=C18+C21+C23+C24"
Range("D18:G26") = Range("D18") ' For Merged Cells
   Worksheets("Input Sheet").Activate
   
   Application.EnableEvents = True
End Sub
I've marked the change in red. I've also changed the part in blue as it was only looking at the active sheet
 
Upvote 0
I feel elated! This is working now!! I can't thank you enough for your help on this. Obviously I have a lot to learn about VBA and how to use it.

I don't exactly understand what the (i / 2) is doing relative to the RngAry but I will continue to read and learn.

Thanks again for all your help!

-Chris
 
Upvote 0
It's where I went wrong initially (serves me right for trying to run it)
The code is looping through an array of 18 elements (0 to 17), but RngAry is declared as RngAry(8) and as i is being increased by 2 each loop it goes 0,2,4,6 etc so when i=10 the macro crashes.
By dividing i by 2 RngAry(i/2) is then going 0,1,2,3 etc
 
Upvote 0
This leads me to my original thought of why add the Step 2 for incrementing 2, 4, 6 etc. Unless we're saying this because we're setting both the SheetName to the Range.

ACQ_FEE_RANGE with a Range of A1:K5 where ACQ_FEE_RANGE would be step one and Range(A1:K5) is Step 2.

Feel free to ignore this post if it's completely off base. :-)

-Chris
 
Upvote 0
You've got that just right. :)

If you prefer you could also do it like this
Code: 
   Dim RngAdd As Variant, ColAry As Variant, ShtAry As Variant
  
   ColAry = Array(9, 12, 11, 13, 13, 11, 7, 11, 13)                                  'The column numbers for the vReturn value
   ShtAry = Array("ACQ_FEE_RANGE", "DLR_FLAT_FEE", "FINC_AMT_RT_ADJ", "FS_PART_PCT", "FS_PART_SPLIT_PCT", "LTV_SCORE_RT", "RT_SHEET", "TERM_PRICE_ADJ", "VEH_AGE_ADJ")
   RngAdd = Array("A1:K5", "A1:N13", "A1:N117", "A1:O5", "A1:O3", "A1:L598", "A1:N76", "A1:N211", "A1:P111")    'The sheet ranges for the filter
   

   For i = 0 To UBound(RngAdd) Step 1
         Set RngAry(i) = Sheets(ShtAry(i)).Range(RngAdd(i))
   Next i
Where there is an extra array & everything loops step 1
 
Upvote 0
Ahh ok, this makes sense as well. 2 separately defined arrays so you only need to use Step 1.

Light bulbs coming on all over the place!

Thank you Fluff!
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Multiple Double Click Events on Different Ranges in 1 Worksheet
Replies
1
Views
1K
kevin9999
K
A
  • Question Question
Excel VBA: Loop through autofilter criteria to copy and paste to new sheet then save as new file.
Replies
1
Views
1K
alantse2010
A
S
  • Question Question
Autofilter Table Based on Range of Values from a Different Sheet
Replies
0
Views
588
SighSigh10
S
M
  • Question Question
Need to get Sum of a Column based on values satisfying criteria in 6 different columns
Replies
0
Views
690
mrugeshpoojary
M
G
  • Question Question
Excel VBA Macro steps through ok but when run it causes duplication
Replies
2
Views
4K
Gassy
G

Forum statistics

Threads
1,223,893
Messages
6,175,244
Members
452,622
Latest member
Laura_PinksBTHFT

Share this page

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
Back
Top