Loop through Multiple Worksheets, with autofilter, for different Criteria

[Cooliozar]

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:

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

 

[Fluff]

Hi & welcome to the board.
Maybe something like

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 RngAry As Variant, i As Long, j As Long
Dim CritAry(8) As Variant
Dim vReturn(8) 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("pcode").Range("A1:K5")
Set rRng2 = Worksheets("pcode1").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")

CritAry(0) = Array(1, rInput1.Value, 3, "<=" & rInput3.Value, 4, ">=" & rInput3.Value)
CritAry(1) = Array(1, rInput1.Value, 2, "<=" & rInput7.Value, 10, ">=" & rInput7.Value)
RngAry = Array(rRng1, 9, rRng2, 12)

For i = 0 To UBound(RngAry) Step 2
   If RngAry(i).Parent.AutoFilterMode Then RngAry(i).Parent.AutoFilterMode = False
   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, RngAry(i + 1)), .Cells(Rows.Count, RngAry(i + 1)).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1)
   End With
Next i

Worksheets("Input Sheet").Activate

Application.EnableEvents = True

End Sub

 

[Fluff]

Slimmed it down a bit more

Sub Calculations()
   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
  
   [COLOR=#0000ff]ColAry = Array(9, 12) [/COLOR]                          'The column numbers for the vReturn value
   [COLOR=#0000ff]Rngadd = Array("A1:K5", "A1:N13", "A1:N117") [/COLOR]   'The sheet ranges for the filter
   
   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
 
   For i = 1 To 8
      InAry(i) = Sheets("Input Sheet").Range("C" & i + 6).Value
   Next i
 
   [COLOR=#ff0000]CritAry(0) = Array(1, InAry(1), 3, "<=" & InAry(3), 4, ">=" & InAry(3))
   CritAry(1) = Array(1, InAry(1), 2, "<=" & InAry(7), 10, ">=" & InAry(7))[/COLOR]
   
   For i = 0 To UBound(Rngadd)
      Set RngAry(i) = Sheets("pcode" & i + 1).Range(Rngadd(i))
   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
   
   Worksheets("Input Sheet").Activate
   
   Application.EnableEvents = True

End Sub

You'll need to add to the arrays in blue for the other sheets. Likewise you'll need to replicate the arrays in red.

 

[Cooliozar]

Thanks for both responses. I've only had a small amount of time to work with the first example you provided and it appears to do what I need it to with the exception of the following:

1. I get an data type mismatch on the 3rd array and I just can't pin point why within the array.
2. I don't understand how to get my return values to be selected from each sheet and added back to the "Input Sheet" where I can then perform a calculation against them.

I will take a look at the the 2nd array and see if I can incorporate it and understand the whole solution.

Thank you so much for your feedback. It's invaluable.

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

-Chris

 

[Fluff]

For point 1, could you post the array as you have it?
For point 2, what do you want to happen with the return value?

 

[Cooliozar]

Ok, shifting gears slightly. I used the 2nd codeset you posted and I'm getting a "subscript out of range" error when I get to the following section:
For i = 0 To UBound(Rngadd)
Set RngAry(i) = Sheets("pcode" & i + 1).Range(Rngadd(i))
Next i

In my code I've substituted the "pcode" with the actual worksheet name that I'm wanting to start with. Since I have 9 worksheets will I need to have 9 lines with "Set RngAry(i) = Sheets("pcode" & i + 1).Range(Rngadd(i))" where "pcode" represents each of the 9 different Worksheet names?

The 2nd question from above still remains. Let me give more detail. Originally I had Dimmed 9 vReturn values. When each worksheet was filtered and the value selected from the expected cell then it was placed into the defined vReturn variable for that set as seen here:

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

Then the code place each of the selected values into the "Input Sheet" in specific cells and did a calculation on them which showed up in a set of merged cells as follows:

Range("C18").Value = vReturn1
Range("C19").Value = vReturn2
Range("C20").Value = vReturn3
Range("C21").Value = vReturn4
Range("c22").Value = vReturn5
Range("C23").Formula = (vReturn6 / 100)
Range("C24").Value = vReturn7
Range("C25").Value = vReturn8
Range("C26").Value = vReturn9
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'm not understanding how the single vReturn(i) in the With statement captures each filtered/selected value and then moves it into the specified cell/range so the calculation can be performed. I'm thinking I need another defined array for the vReturn values so I can specify the cells to place them in on the "Input Sheet".

I hope this isn't too confusing and I really appreciate your help. If I need to, I can send the whole project.

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

-Chris

 

[Fluff]

Are your sheets named like "Worksheet1", "Worksheet2" (ie a name followed by consecutive numbers), or do they have individual names such as "Jan", "Feb" etc?

 

[Cooliozar]

They all have different names. "ACQ_FEE", "AGE_ADJ", "FLAT_FEE" etc.

 

[Fluff]

Ok change the Rngadd to

Rngadd = Array("sheet1", "A1:K5", "sheet2", "A1:N13", "sheet3", "A1:N117")

and the RngAry to

   For i = 0 To UBound(Rngadd) Step 2
      Set RngAry(i) = Sheets(RngAry(i)).Range(Rngadd(i + 1))
   Next i

What I forgot to mention is that all the arrays need to be built in the same order. So the ColAry needs to be for sheet1 then sheet2 etc & the CritAry(0) is for sheet1 CritAry(1) for sheet2 etc.

 

[Cooliozar]

For ease of conversation I'm going to go ahead and post the entirety of my current script. For clarification, in my Excel Workbook I have 13 total Worksheets ordered as follows:

Sheet1 (CVOS Pricing Calculator) - This is the sheet where input values are entered as well as the filtered/selected values are returned
Sheet2 (DD_VALUES) - This is simply a sheet that allows for values to be selected from a drop down on sheet1 (CVOS Pricing Calculator)
Sheet3 (ACQ_FEE_RANGE) - Row 1 Header, the rest is data
Sheet4 (DLR_FLAT_FEE) - Row 1 Header, the rest is data
Sheet5 (FINC_AMT_RT_ADJ) - Row 1 Header, the rest is data
Sheet6 (FS_PART_PCT) - Row 1 Header, the rest is data
Sheet7 (FS_PART_SPLIT_PCT) - Row 1 Header, the rest is data
Sheet8 (LTV_SCORE_RT) - Row 1 Header, the rest is data
Sheet9 (RT_SHEET) - Row 1 Header, the rest is data
Sheet10 (TERM_PRICE_ADJ) - Row 1 Header, the rest is data
Sheet11 (VEH_AGE_ADJ) - Row 1 Header, the rest is data

I understand what the For/Next loops are doing but I can't get it to select the correct values and end up with a Run Time Error 13 - type mismatch at Set RngAry(i) = Sheets(RngAry(i)).Range(Rngadd(i + 1)).

Additionally, I still don't know if I'm using my vReturn correctly at the very end of the code where I've defined the range for the value and then use .Formula for calculations. Here's the code:

Sub CVOSCalc()
   Dim RngAry(9) As Range, CritAry(9) As Variant, vReturn(9) 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("ACQ_FEE_RANGE", 9, "DLR_FLAT_FEE", 12, "FINC_AMT_RT_ADJ", 11, "FS_PART_PCT", 13, "FS_PART_SPLIT_PCT", 13, "LTV_SCORE_RT", 11, "RT_SHEET", 7, "TERM_PRICE_ADJ", 11, "VEH_AGE_ADJ", 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(RngAry(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 = vReturn1
Range("C19").Value = vReturn2
Range("C20").Value = vReturn3
Range("C21").Value = vReturn4
Range("c22").Value = vReturn5
Range("C23").Formula = (vReturn6 / 100)
Range("C24").Value = vReturn7
Range("C25").Value = vReturn8
Range("C26").Value = vReturn9
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

My apologies if this is something really simple I'm missing. I'm pretty new to VBA and just want to simplify the code as I add on a large number of Worksheets to filter through for return values based on the inputs.

Thanks for all of your help with this.

-Chris