Forum Discussion
Help with Macro to collate data
- Jul 23, 2020
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.
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.
- calof1Jul 24, 2020Iron Contributor
Thank you again for your assistance, this works exactly as i had hoped.
Hope you are staying safe and well, and greatly appreciate your assistance.
Many thanks,
- Subodh_Tiwari_sktneerJul 24, 2020Silver Contributor
- calof1Jul 31, 2020Iron Contributor
Hope you are wellSubodh_Tiwari_sktneer
Please be advised i have started using the tracker with your function, i have just noticed one thing i wish to update if possible.
On the attached in the tab "boral" you will see some funds which are eligible but choose "no" to participating. For our summary tab, would it be possible to only bring across funds which have choosen "yes" to participating?
Please let me know if i can update this.
Many thanks,