0

i need a loop for created 2 codes (there will be more) . As for now in column O i have 2 conditions/criteria based on which i'm using for filter a table with data. Right now i just made one by one, but in future i want to add to column O more criteria that is why i am asking to make some loop to do all action until all criteria in column O will be finished. As well - how it might look if i want to add next criteria but in column P (so 1st do all in column O, when all criteria are finished go to P etc...)

Sub FILTER1st()
'

Sheets("schedule").Select
'
Dim filterValue As Variant

' Copy the value from cell O3
filterValue = ThisWorkbook.Sheets("schedule").Range("O3").Value

' 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
    ActiveSheet.Paste
    
    End Sub
Sub FILTER2nd()
    
Sheets("schedule").Select
'
Dim filterValue As Variant

' Copy the value from cell O4
filterValue = ThisWorkbook.Sheets("schedule").Range("O4").Value

' 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).Offset(1).Select
    ActiveSheet.Paste
End Sub
nozu1984
  • 9
  • 3

1 Answers1

0

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

Chronocidal
  • 6,827
  • 1
  • 12
  • 26
  • Hello @Chronocidal , first of all - huge thanks for so fast answer :) As for now all works. I have just one question about Last Row - how to adjust code if i don't know which row will be final (let's say once it will be 4th, once it will be 10th row in Column O) - how make it to works till last value in column O without specifying fixed value ? – nozu1984 Feb 03 '23 at 14:40
  • @nozu1984 You can use `.End(..)` to find the cell, and `.Row` to return which row it is, e.g. `LastRow = ThisWorkbook.Sheets("schedule").Cells(ThisWorkbook.Sheets("schedule").Rows.Count, FilterColumn).End(xlUp).Row` – Chronocidal Feb 03 '23 at 15:27