Excel VBA loop until

Question

I am using the following if code to filter col A and col B by the value in F1

Once sorted I copy the the filtered values in col A and paste them under the range value.

Then I move on to the next range and repeat the filter using a different range value (in this case cell G1).

I need to repeat this from cell F1 through to cell AH1.

Can I use a loop to do this?

If Range("F1").Value <> "" Then

    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$B" & LastRow).AutoFilter Field:=2, Criteria1:=Range("F1").Value

    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1").Select

End If

If Range("G1").Value <> "" Then

    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$B" & LastRow).AutoFilter Field:=2, Criteria1:=Range("G1").Value

    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1").Select

End If

score 2 · Accepted Answer · edited May 23 '17 at 12:15

Try the loop below. I have refactored your code to not use ActiveSheet and Select statements. Instead I qualify all objects and methods to their parent object and work directly with the object. It will avoid many pitfalls and errors in expected versus actual results of the code.

Dim LastRow As Long
'assume LastRow already set

Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'change as needed

With ws

    Dim cel As Range
    For Each cel In .Range("F1:AH1")
        If Len(cel) > 0 Then
            ws.UsedRange.AutoFilter
            .Range("A2:B" & LastRow).AutoFilter Field:=2, Criteria1:=cel.Value
            .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=cel.Offset(1)
        End If
    Next

End With

See How to Avoid Select

Excel VBA loop until

1 Answers1