Forum Discussion
Help with Macro to collate data
Hi,
I have a spreadsheet i will use to record our submissions for Class Actions. Each tab is for one Class action or stock.
As there is many tabs i wish to have a summary tab for those which are "Active". I have called this "Summary Active" in the attached spreadsheet. I am hoping to be able to have this tab populate itself via formula or macro, as each tab has the same format. The criteria i am using is the Class action is "Open" (column H), is participating (Column E).
Then i am hoping to have it sorted via Fund Name (Column A).
Can someone please assist in helping me address this problem.
Thank you kindly for any assistance.
You may try something like this....
Sub CreateSummary() Dim wsSummary As Worksheet Dim ws As Worksheet Dim dlr As Long Dim lr As Long Application.ScreenUpdating = False Set wsSummary = Worksheets("Summary - Active") wsSummary.Range("A1").CurrentRegion.Offset(1).Clear For Each ws In ThisWorkbook.Worksheets If Not ws.Name Like "List*" And Not ws.Name Like "Summary*" Then ws.AutoFilterMode = False lr = ws.Cells(Rows.Count, 1).End(xlUp).Row dlr = wsSummary.Cells(Rows.Count, 1).End(xlUp).Row + 1 With ws.Range("A1").CurrentRegion .AutoFilter field:=9, Criteria1:="Open" If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then ws.Range("B2:B" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("A" & dlr) ws.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("B" & dlr) ws.Range("C2:C" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("C" & dlr) ws.Range("D2:D" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("D" & dlr) ws.Range("G2:G" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("E" & dlr) ws.Range("H2:H" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("F" & dlr) ws.Range("J2:J" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("G" & dlr) End If End With ws.AutoFilterMode = False End If Next ws dlr = wsSummary.Cells(Rows.Count, 1).End(xlUp).Row + 2 wsSummary.Range("B2:B" & dlr).Borders(xlEdgeRight).Weight = xlThin wsSummary.Range("G2:B" & dlr).Borders(xlEdgeRight).Weight = xlThick wsSummary.Sort.SortFields.Clear wsSummary.Range("A1").CurrentRegion.Sort key1:=wsSummary.Range("A2"), order1:=xlAscending, Header:=xlYes Application.ScreenUpdating = True End SubIn the attached, you will find a button called "Create Summary" on Summary Tab, you may click this button to run the macro to create the desired summary.
11 Replies
Please populate the tabs with some dummy data and then mock up the summary tab manually to show us the end result and then upload the sample file again.
Thank you kindly for your message.
I have populated a small sample for each tab. Essentially each tab is a Class action, so i have coloured each of them to help make it easy showing where the data for the summary tab has come from.
The summary tab essentially is using the response of "Status" & "Participating" as the identifers. If the status is "Open", and the fund is "Yes" for participating then it will come onto the summary tab.
I am then hoping to have it sorted via "Fund Name", so that it is easy to show which Class actions the fund is currently participating in at any time.
Please let me know any questions or suggestions you have, and once again greatly appreciate your assistance.
Many thanks,
You may try something like this....
Sub CreateSummary() Dim wsSummary As Worksheet Dim ws As Worksheet Dim dlr As Long Dim lr As Long Application.ScreenUpdating = False Set wsSummary = Worksheets("Summary - Active") wsSummary.Range("A1").CurrentRegion.Offset(1).Clear For Each ws In ThisWorkbook.Worksheets If Not ws.Name Like "List*" And Not ws.Name Like "Summary*" Then ws.AutoFilterMode = False lr = ws.Cells(Rows.Count, 1).End(xlUp).Row dlr = wsSummary.Cells(Rows.Count, 1).End(xlUp).Row + 1 With ws.Range("A1").CurrentRegion .AutoFilter field:=9, Criteria1:="Open" If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then ws.Range("B2:B" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("A" & dlr) ws.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("B" & dlr) ws.Range("C2:C" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("C" & dlr) ws.Range("D2:D" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("D" & dlr) ws.Range("G2:G" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("E" & dlr) ws.Range("H2:H" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("F" & dlr) ws.Range("J2:J" & lr).SpecialCells(xlCellTypeVisible).Copy wsSummary.Range("G" & dlr) End If End With ws.AutoFilterMode = False End If Next ws dlr = wsSummary.Cells(Rows.Count, 1).End(xlUp).Row + 2 wsSummary.Range("B2:B" & dlr).Borders(xlEdgeRight).Weight = xlThin wsSummary.Range("G2:B" & dlr).Borders(xlEdgeRight).Weight = xlThick wsSummary.Sort.SortFields.Clear wsSummary.Range("A1").CurrentRegion.Sort key1:=wsSummary.Range("A2"), order1:=xlAscending, Header:=xlYes Application.ScreenUpdating = True End SubIn the attached, you will find a button called "Create Summary" on Summary Tab, you may click this button to run the macro to create the desired summary.
