copy data from a filtered list

[pyclen]

Hi All,

I am trying to automate something, namely, after downloading CC data/transactions as CSV (and saving them as Xslx file), I want to copy data from each user to a new tab so I can then further filter the data.

Below is a table that I made up as example (names, etc are irrelevant for this exercise), there are 3 users of this credit card (John, WIlly, Jane), and I want to filter the data by user and copy it to a different sheet (like the 2nd table (on a separate tab) I show below w/just Jane's data)

What is the best way to search the whole list and just copy Jane (or John or Willy) to a 2nd/3rd etc tab? I am using Office365 (or whatever the current moniker is)

Thanks in advance for your help

Merchant	Date	Amount	User
Home Depot	20-Dec-24	$245.12	John
Lowes	21-Dec-24	$100.62	Willy
McD	21-Dec-24	$66.66	John
Wendy's	22-Dec-24	$55.55	Willy
Domino's	24-Dec-24	$128.22	Jane
CVS	24-Dec-24	$254.29	John
Ice Cream Shop	22-Dec-24	$38.00	Willy
TJMaxxx	21-Dec-24	$66.00	Jane
Ace Hardware	19-Dec-24	$44.22	Jane
Dr Y dentist	21-Dec-24	$25.00	Jane
City of FU Water	21-Dec-24	$290.77	John
Internet by Data	21-Dec-24	$100.00	Willy
Electricity by Power	21-Dec-24	$267.99	Jane
Gas by stinky	21-Dec-24	$45.00	Jane
Tireshop	21-Dec-24	$988.99	Willy
Chinese Food	21-Dec-24	$33.00	John
Walmart	2-Jan-25	$125.34	John
Walmart 2	2-Jan-25	$126.20	Jane
Walmart 3	2-Jan-25	$15.27	Willy
Kroger	2-Jan-25	$68.43	John
Aldi	4-Jan-25	$76.94	John
Costco	3-Jan-25	$583.16	John
BJ's	5-Jan-25	$989.33	Willy
Shell Gas	5-Jan-25	$75.25	Jane
BP Gas	3-Jan-25	$35.80	Willy
FU Hospital	2-Jan-25	$985.25	Willy
Dr X Primary Care	6-Jan-25	$50.00	Jane

Merchant	Date	Amount	User
Domino's	########	$128.22	Jane
TJMaxxx	########	$66.00	Jane
Ace Hardware	########	$44.22	Jane
Dr Y dentist	########	$25.00	Jane
Electricity by Power	########	$267.99	Jane
Gas by stinky	########	$45.00	Jane
Walmart 2	2-Jan-25	$126.20	Jane
Shell Gas	5-Jan-25	$75.25	Jane
Dr X Primary Care	6-Jan-25	$50.00	Jane

 

[Joe4]

How about using the new FILTER function, which allows you to do that with one simple formula (per person)?
See: FILTER Function

 

[pyclen]

How about using the new FILTER function, which allows you to do that with one simple formula (per person)?
See: FILTER Function

I would have to look at that; however, I want the data for each user on a new tab and then further filter down with w/sumif and countif to see how often money is spent at each merchant and what the total paid is. I am not sure I can get that with FILTER, or it would most likely be a very, very long, unwieldy formula since I need it for three users

 

[Joe4]

Assuming that you start off with one sheet named "Sheet1" and your data starts in cell A1, as long as your data is structured exactly as you have shown, this should automate the task of inserting new pages for each person, and applying that Filter function to each one to get what you want:

Sub MyMacro()

    Dim lr As Long, lrT As Long
    Dim ws1 As Worksheet
    Dim i As Long
    Dim n As String

    Application.ScreenUpdating = False

'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Insert new "Temp" sheet
    Sheets.Add(After:=Sheets("Sheet1")).Name = "Temp"
    
'   Copy date from 4th column (Name) on Sheet1 to Temp sheet
    Sheets("Sheet1").Columns("D:D").Copy Sheets("Temp").Range("A1")

'   Remove duplidates from Temp sheet
    Sheets("Temp").Range("$A$1:$A$30").RemoveDuplicates Columns:=1, Header:=xlYes
    
'   Find last row with data on "Temp" sheet
    lrT = Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through unique names on "Temp" Sheet
    For i = 2 To lrT
'       Get name
        n = Sheets("Temp").Range("A" & i).Value
'       Insert new sheet at end and rename with name
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = n
'       Copy headers from Sheet1
        Sheets("Sheet1").Range("A1:D1").Copy Sheets(n).Range("A1")
'       Insert Filter formula in cell A1 of new sheet
        Sheets(n).Activate
        Range("A2").Formula2 = "=FILTER(Sheet1!A2:D" & lr & ",Sheet1!D2:D" & lr & "=" & Chr(34) & n & Chr(34) & ")"
'       Format columns B and C
        Columns("B:B").NumberFormat = "d-mmm-yy"
        Columns("C:C").NumberFormat = "$#,##0.00"
'       Autofit columns
        Cells.EntireColumn.AutoFit
    Next i
    
'   Delete "Temp" sheet
    Sheets("Temp").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"

End Sub

 

[pyclen]

Assuming that you start off with one sheet named "Sheet1" and your data starts in cell A1, as long as your data is structured exactly as you have shown, this should automate the task of inserting new pages for each person, and applying that Filter function to each one to get what you want:

Sub MyMacro()

    Dim lr As Long, lrT As Long
    Dim ws1 As Worksheet
    Dim i As Long
    Dim n As String

    Application.ScreenUpdating = False

'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Insert new "Temp" sheet
    Sheets.Add(After:=Sheets("Sheet1")).Name = "Temp"
   
'   Copy date from 4th column (Name) on Sheet1 to Temp sheet
    Sheets("Sheet1").Columns("D:D").Copy Sheets("Temp").Range("A1")

'   Remove duplicates from Temp sheet
    Sheets("Temp").Range("$A$1:$A$30").RemoveDuplicates Columns:=1, Header:=xlYes
   
'   Find last row with data on "Temp" sheet
    lrT = Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row
   
'   Loop through unique names on "Temp" Sheet
    For i = 2 To lrT
'       Get name
        n = Sheets("Temp").Range("A" & i).Value
'       Insert new sheet at end and rename with name
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = n
'       Copy headers from Sheet1
        Sheets("Sheet1").Range("A1:D1").Copy Sheets(n).Range("A1")
'       Insert Filter formula in cell A1 of new sheet
        Sheets(n).Activate
        Range("A2").Formula2 = "=FILTER(Sheet1!A2:D" & lr & ",Sheet1!D2:D" & lr & "=" & Chr(34) & n & Chr(34) & ")"
'       Format columns B and C
        Columns("B:B").NumberFormat = "d-mmm-yy"
        Columns("C:C").NumberFormat = "$#,##0.00"
'       Autofit columns
        Cells.EntireColumn.AutoFit
    Next i
   
'   Delete "Temp" sheet
    Sheets("Temp").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!"

End Sub

Hi Joe

thank you very much for the macro, worked like charm

 

[Joe4]

You are welcome.

Please Note: In the future, when marking a post as the solution, please mark the post that contains the solution (not your own post acknowledging that some other post was the solution).
When a post is marked as the solution, it is then shown right underneath the original question so people viewing the question can easily see the question and solution in a single quick glance without having to hunt through all the posts.

I have updated this thread for you.