SOLVED

Help with Macro to collate data

Iron Contributor

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.

11 Replies

@calof1 

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.

Hi@Subodh_Tiwari_sktneer 

 

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,

 

best response confirmed by calof1 (Iron Contributor)
Solution

@calof1 

 

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 Sub

In 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.

 

 

Hi@Subodh_Tiwari_sktneer

 

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, 

@calof1 

You're welcome! Glad it worked as desired.

Thanks! I hope you too are staying safe and well.

Hope you are well@Subodh_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,

@calof1 , Here's a non-macro, Power Query solution. When the data in the 3 input tabs change, click on Data->Refresh All to update the summary tab.

@calof1 

Please test the attached.

 

Hi@TheAntony 

 

Thank you kindly for your assistance.

 

I have tested this and it works as i have desired.

 

Greatly appreciate finding different ways to solve the issue, and for your assistance with this.

 

Have a great weekend.

 

Thanks

Hi@Subodh_Tiwari_sktneer 

 

thank you again for your assistance, always much appreciated.

 

I have tested with the data i have and worked exactly as desired.

 

Thank you again, and hope you have a great weekend ahead.

 

All the best.

 

 

@calof1 

You're welcome again! Glad it worked as desired.

 

Thanks and you too!

 

1 best response

Accepted Solutions
best response confirmed by calof1 (Iron Contributor)
Solution

@calof1 

 

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 Sub

In 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.

 

 

View solution in original post