Search code examples
excelvba

How can I loop a copy/paste code based on a filter?


I need to send a daily update that's giving me a lot of trouble, so I tried automating it. I have a dataset with clients attributed to different sellers, and I basically need to filter the list for EVERY seller (there are more than 60, growing regularly) and send the list to each person via e-mail.

I've managed to create a copy paste macro based on the worksheet and managed to filter the clients dataset based on the sellers list (on a separate worksheet) and automatically copy/paste the list to an email tab, but I just can't seem to loop the filter so it does the same automatically to all 60+ sellers. I could just copy the lines and change the filter's range, but it seems a little bit of a rework seeing as new sellers come and some go regularly (I would have to change the range in the code everytime someone comes/goes).

Sub copy_paste()
 
 
Set object_outlook = CreateObject("Outlook.Application")
Set Email = objeto_outlook.createitem(0)

'this spreadsheet is the dataset, a pivot table that i need to filter manually to have a daily presentation with graphs, so I can't really change anything from it
Dim lRow As Long
Dim sht As Worksheet
Set sht = Sheets("PivotDataset")
Dim a As String

'the destination sheet is a temporary copy of the dataset that I use to filter
Dim lRowDestinationTable As Long
Dim DestinationSheet As Worksheet
Set DestinationSheet = Sheets("DatasetCopy")
 
'the Email Sheet is the final one that is copied and transformed into HTML
Dim lRowEmailSheet As Long
Dim EmailSheet As Worksheet
Set EmailSheet = Sheets("sendSheet")
 
lRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row
lRowDestinationTable = DestinationSheet.Cells(dest.Rows.Count, 2).End(xlUp).Row
a = Sheets("SellersList").Range("A2").Value
 
sht.Range("B21:F" & lRow).Copy
 
With Sheets("DatasetCopy")
    .Range("A2").PasteSpecial xlPasteFormats
    .Range("A2").PasteSpecial xlPasteValues

'this is the filter I need to turn dynamic, it only filters the first seller on the list so far, and I haven't found any other filter that works
        ActiveSheet.ListObjects("CopyTable").Range.AutoFilter Field:=1, Criteria1:=a
End With
 
    DestinationSheet.Range("A2:E99999").SpecialCells(xlCellTypeVisible).Copy
 
With Sheets("sendSheet")
   .Range("A2").PasteSpecial xlPasteFormats
   .Range("A2").PasteSpecial xlPasteValues
lRowEmailSheet = EmailSheet.Cells(EmailSheet.Rows.Count, 2).End(xlUp).Row
 
'This part opens the e-mail tab and inserts the filtered clients table + any other text I want
Email.display
Email.to = Sheets("PivotDataset").Cells(4, 3).Value
Email.Subject = "Clients list"
text1 = "Hi, " & seller's name & "!"
Email.htmlbody = texto1 & "<br><br>" & rangetohtml(sendSheet.Range("B1:E" & lRowEmailSheet)) & Email.htmlbody

End With
 
On Error Resume Next
 
End Sub

As every seller has a different clients list, the table field is dynamic, that part I got right. I also have a function that translates the excel data tables into HTML to insert it into the E-Mail, and that works just fine too

Is there any way I can loop the copy/paste command and filter so it automatically filters the table? It is a regular named table, not a pivot table, so the filtering method may not be the best, but it's what I could muster...


Solution

  • Congratulations on getting this far. That's how I started my programming journey too!

    a = Sheets("SellersList").Range("A2").Value
    ...
    ActiveSheet.ListObjects("CopyTable").Range.AutoFilter Field:=1, Criteria1:=a
    

    This is where your code decides what values to filter on. You can verify for yourself by hardcoding values of a and see if it generates the right result:

    a = "another name"
    ...
    ActiveSheet.ListObjects("CopyTable").Range.AutoFilter Field:=1, Criteria1:=a
    

    If the above works, this is what you need:

    First, you need a unique list of sellers, so you can apply them to the filter individually. You can use Range.AdvancedFilter to filter for unique values in column A, then copy the visible cells onto a working sheet.

    Next, you need either a For loop or a For Each loop to set a different value of a for each iteration.

    I see you've mastered the LastRow "trick", so you can do the same:

    Dim LR as long
    Dim i as long
    
    LR = ThisWorkbook.Sheets("PastedUnique").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 to LR
        a = Sheets("SellersList").Range("A" & i).Value
        ....
        ActiveSheet.ListObjects("CopyTable").Range.AutoFilter Field:=1, 
        Criteria1:=a
        ... ' whatever email code
        ... ' whatever clean up code before starting the next iteration. eg. clear filter
    Next i
    

    It has been more than a decade since I last wrote vba, so excuse me if the code doesn't work directly. FWIW, there are better ways to do this, and im certain you'll figure it out as you tinker more with VBA. For now, this is the easiest to execute.