CODEWITHSUNDEEP
excelvbaautofilter
Mistakamikaze
Mistakamikaze

Reputation: 442

How to loop through each row where there are a varying number of rows?

I have a spreadsheet called "old":

col1 col2 col3
A B C
D E F
-- -- --

I have another spreadsheet called "new" that is empty.

I want to copy every row from "old" that has "col3 = C" and "col2 ending in B" to "new".

This is what I tried.
I select A1 - L34 before applying a filter because my test data has only entries in A1 - L34 but this obviously isn't extensible.
I want it so the range isn't hardcoded.

Sub Test()

    Sheets("Old").Select
    Range("A1:L34").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$O$8351").AutoFilter Field:=3, Criteria1:="C"
    ActiveSheet.Range("$A$1:$O$8351").AutoFilter Field:=2, Criteria1:="=*B", _
        Operator:=xlAnd
       
    Range("A1:L34").Select
    Selection.Copy
   
    Sheets("New").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub

Upvotes: 1

Views: 137

Answers (3)

VBasic2008
VBasic2008

Reputation: 54807

Copy Rows With Matching Conditions

Option Explicit

Sub Test()
    Dim rng As Range
    With ThisWorkbook.Worksheets("Old")
        .AutoFilterMode = False
        With .Range("A1").CurrentRegion
            .AutoFilter Field:=2, Criteria1:="=*B"
            .AutoFilter Field:=3, Criteria1:="C"
            On Error Resume Next
            Set rng = .Resize(.Rows.Count - 1).Offset(1) _
                .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        .AutoFilterMode = False
    End With
    If Not rng Is Nothing Then
        rng.Copy ThisWorkbook.Worksheets("New").Range("A1")
    End If
End Sub

Upvotes: 0

Harun24hr
Harun24hr

Reputation: 36870

Try below sub.

Sub CopyCB()
Dim rng As Range
Dim lRow As Long
Dim sh As Worksheet

    Set sh = Sheets("old")
    lRow = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row

    Set rng = Range("A1:L" & lRow)
    rng.AutoFilter
    rng.AutoFilter Field:=3, Criteria1:="C"
    rng.AutoFilter Field:=2, Criteria1:="=*b", Operator:=xlAnd
    rng.SpecialCells(xlCellTypeVisible).Copy Sheets("new").Range("A1")
    
Set rng = Nothing
Set sh = Nothing
End Sub

Upvotes: 1

Mistakamikaze
Mistakamikaze

Reputation: 442

Sub Test()

    Sheets("Old").Select
    ActiveSheet.UsedRange.Select
    Selection.AutoFilter
    ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:="C"
    ActiveSheet.UsedRange.AutoFilter Field:=2, Criteria1:="=*B", _
        Operator:=xlAnd
       
    ActiveSheet.UsedRange.Select
    Selection.Copy
   
    Sheets("New").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub

Upvotes: 0

Related Questions