CODEWITHSUNDEEP
excelvbaif-statementcopy-paste
excelnoob
excelnoob

Reputation: 1

Copy multiple ranges from a sheet to another sheet with different range with IF statement

I am trying to find an easy way to summarise the code below, because I have 100 different copy ranges to be copied to another range.

I have linked the code for the first 6 below.

Public Sub AttributesFilter()

Dim Rowwrr As Long

Let Rowwrr = Worksheets("Attributes Filter").Range("A2").Value

If Worksheets("Attributes Filter").Range("D2") <> "N/A" Then
Worksheets("Attributes Helper").Range("d2:d" & Rowwrr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Attributes Filter").Range("d2"), Unique:=True
End If

If Worksheets("Attributes Filter").Range("e2") <> "N/A" Then
Worksheets("Attributes Helper").Range("e2:e" & Rowwrr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Attributes Filter").Range("g2"), Unique:=True
End If

If Worksheets("Attributes Filter").Range("f2") <> "N/A" Then
Worksheets("Attributes Helper").Range("f2:f" & Rowwrr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Attributes Filter").Range("j2"), Unique:=True
End If

If Worksheets("Attributes Filter").Range("g2") <> "N/A" Then
Worksheets("Attributes Helper").Range("g2:g" & Rowwrr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Attributes Filter").Range("m2"), Unique:=True
End If

If Worksheets("Attributes Filter").Range("h2") <> "N/A" Then
Worksheets("Attributes Helper").Range("h2:h" & Rowwrr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Attributes Filter").Range("p2"), Unique:=True
End If

If Worksheets("Attributes Filter").Range("i2") <> "N/A" Then
Worksheets("Attributes Helper").Range("i2:i" & Rowwrr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Attributes Filter").Range("s2"), Unique:=True
End If

End Sub

Can someone help me find an easier way to do this for 100 columns? (D2:D & Rowwrr to CY2:CY & Rowwrr) and (D2 to KO2) with the condition <> N/A

Upvotes: 0

Views: 131

Answers (1)

Basbadger
Basbadger

Reputation: 234

Use a for loop and Cells and the column index rather than letter. I believe this should work for you.

Public Sub AttributesFilter()

Dim Rowwrr As Long

    Let Rowwrr = Worksheets("Attributes Filter").Range("A2").Value

    For i = 4 To 9 'change 9 to whatever column number you need to go to
        If Worksheets("Attributes Filter").Cells(2, i) <> "N/A" Then
            Worksheets("Attributes Helper").Range(Cells(2, i).Address, Cells(Rowwrr, i).Address).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Attributes Filter").Cells(2, i), Unique:=True
        End If
    Next i
End Sub

Upvotes: 1

Related Questions