VBA Code for Data Advanced Filer Unique Records

[mazher]

Dear Forum Members,

I need some help from a VBA expert.

I have a summary sheet with the sheet names in Column B starting B2 and down

I have the seller names in each sheet in column B starting B2

I need a VBA code that can check the column B of every sheet mentioned in the Summary sheet and paste me a list of the Unique Suppliers starting in Cell R3 downwards of each sheet

Presently I am using Data Adbaced Filter and have to do it manually for each sheet, by the sheet are increasing after few days and is becoming very tedious.

Hope some VBA expert can help me with this

I have used the macro recorder and it gave me this code

Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Range("D2:D111").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "R2"), Unique:=True

Thanks in advance

 

[Fluff]

How about

Sub mazher()
   Dim Cl As Range
   
   With Sheets("Summary")
      For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
         If Evaluate("isref('" & Cl.Value & "'!A1)") Then
            Sheets(Cl.Value).Range("D2:D1000000").AdvancedFilter xlFilterCopy, , Sheets(Cl.Value).Range("R2"), 1
         End If
      Next Cl
   End With
End Sub

 

[mazher]

Thanks for your reply @Fluff

I have inserted the code in the module and when I ran the macro it's giving me an error

Runtime Error '1004'

The extract range has a missing or an invalid field name

On pressing debug it takes me to this line of code

Sheets(Cl.Value).Range("D2:D1000000").AdvancedFilter xlFilterCopy, , Sheets(Cl.Value).Range("R2"), 1

 

[mazher]

Dear @Fluff
I spotted the problem, the extracted range has data in it.

Please can some code be added to clear the extracted range before doing the Data>Advanced Filter > Unique Records?

 

[Fluff]

Do you already have data in R2?

 

[Fluff]

Ok, how about

Sub mazher()
   Dim Cl As Range
   Dim Ws As Worksheet
   
   Set Ws = Sheets("Summary")
   For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
      If Evaluate("isref('" & Cl.Value & "'!A1)") Then
         With Sheets(Cl.Value)
            .Range("R2", .Range("R" & Rows.Count).End(xlUp)).ClearContents
            .Range("D2", .Range("D" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , .Range("R2"), 1
         End With
      End If
   Next Cl
End Sub

 

[mazher]

Thanks a lot @Fluff

 

[Fluff]

You're welcome & thanks for the feedback.