Okay, so the first thing you want to do is establish which parts of the code are common to them both, and which parts are different. And, in your case, the main difference is the filterValue = ThisWorkbook.Sheets("schedule").Range(???).Value
line, and then dumping the Paste at the end of your other sheet
This means that the loop will be changing this value, and then rerunning the same code. We could do this as a single Sub that included the loop, but for Debugging purposes I propose that it will be easier to have two Subs — one that contains your loop of values, and the other that does something with that value.
So, this first Sub will loop down Column O, and feed the values into a second Sub called ApplyMyFilter()
:
Public Sub FilterControlLoop()
Dim FilterColumn AS Long: FilterColumn = 15 'Column O is Column 15
Dim FirstRow As Long: FirstRow = 3 'Start on Row 3 of Column O
Dim LastRow As Long: LastRow = 4 'Finish on Row 4 of Column O
Dim CurrentRow As Long
If FirstRow > Last Row Then 'Make sure they're the right way around!
CurrentRow = FirstRow
FirstRow = LastRow
LastRow = CurrentRow
End If
'This is the loop itself
For CurrentRow = FirstRow To LastRow
ApplyMyFilter ThisWorkbook.Sheets("schedule").Cells(CurrentRow, FilterColumn).Value
Next CurrentRow
End Sub
So, now we just need to break down your Filter code to accept the value it is being passed as an Argument, instead of looking for a hard-coded value. Also, using .End(xlDown)
and .End(xlToRight)
can have issues, if there is only a single row/column involved. It is much better to do things in reverse, and use .End(xlUp)
and .End(xlToLeft)
:
Private Sub ApplyMyFilter(filterValue AS Variant)
' Go to the "SOP" sheet
ThisWorkbook.Sheets("SOP").Activate
' Filter column using the copied value as filter criteria
ActiveSheet.Range("A1:Z1").AutoFilter Field:=4, Criteria1:=filterValue
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("temp").Select
Range("B3").Select
Selection.End(xlDown).End(xlDown).End(xlUp).Offset(1,0)
ActiveSheet.Paste
End Sub
So, that will run your code as you wrote it. But, while I'm here, there are a few inefficiencies to correct, or improvements to make — mostly centring around How to Avoid Using Select
in Excel VBA
If we run a Sheet(..).Select
, and then an ActiveSheet.<DoSomething>
then (usually, but not quite always) you can just use Sheet(..).<DoSomething>
instead, without having to change the sheet:
ThisWorkbook.Sheets("SOP").Range("A1:Z1").AutoFilter Field:=4, Criteria1:=filterValue
Similarly, the Range.Copy
method will also accept a Destination
argument, instead of needing to use the Clipboard and Paste
it later:
Selection.Copy Destination:=ThisWorkbook.Sheets("temp").Range("B3")
Finally, we can use a With
constructor to reference a Range with respect to itself, eliminating the need for a Selection
:
With ThisWorkbook.Sheets("SOP").Range("B2")
Range(.End(xlToRight), .End(xlDown)).Copy _
Destination:=ThisWorkbook.Sheets("temp").Cells(ThisWorkbook.Sheets("temp").Rows.Count,2).End(xlUp).Offset(1,0)
End With
This lets us reduce the size of your Filter action Sub:
Private Sub ApplyMyFilter(filterValue AS Variant)
' Filter column using the copied value as filter criteria
ThisWorkbook.Sheets("SOP").Range("A1:Z1").AutoFilter Field:=4, Criteria1:=filterValue
With ThisWorkbook.Sheets("SOP").Range("B2")
Range(.End(xlToRight), .End(xlDown)).Copy _
Destination:=ThisWorkbook.Sheets("temp").Cells(ThisWorkbook.Sheets("temp").Rows.Count,2).End(xlUp).Offset(1,0)
End With
End Sub
If you need to have multiple columns, you can just adjust the Control Loop, to include Nested For Loops over both Column and Row, instead of just Column.
You may also want to Clear your "temp" sheet at the start of the Loop Control, with something like:
With ThisWorkbook.Sheets("temp")
Range(.Cells(3, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
End With
Similarly, the With
constructor for the Copy
could be improved slightly like this:
With ThisWorkbook.Sheets("SOP")
Range(.Cells(2, .Columns.Count).End(xlToLeft), .Cells(.Rows.Count, 2).End(xlUp)).Copy _
Or, even just using the Programmatic Object Name of the sheet instead of needing ThisWorkbook.Sheets("SOP")
and ThisWorkbook.Sheets("temp")
; I, personally, find sheet1.Activate
to be much neater than ThisWorkbook.Sheets("SOP").Activate