Generating a Summary that has varying number of entries based

[chiron]

	Section 1
Item No.	Description	Budget	Total Invoice	Current Invoice
1	AAAA	10	10	0
2	BBBB	10	5	2
3	CCCC	10	0	0
4	DDDD	10	3	3
	Subtotal	40	18	5
	Section 2
Item No.	Description	Budget	Total Invoice	Current Invoice
5	E	10	10	0
6	F	10	5	2
7	G	10	0	0
	Subtotal	30	15	2

<tbody>
</tbody>

I want to automatically generate a summary that looks like this in a different sheet;

Item No.	Current Invoice
2	2
4	3
6	2
Total	7

<tbody>
</tbody>

I cannot change the structure of the original table and it has titles repeated as text for each section. What is a good way to do this? The way I am doing it now is to filter and then copy visible cells into the next sheet and total but I think there must be a way to do dynamically generate this table based on the data entered.

 

[DanteAmor]

Hi, Try the following vba code in your sheet "summary", it's very simple. Each time you select the sheet the data is updated automatically.

Change data in red by your information.

Private Sub Worksheet_Activate()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = Sheets("[COLOR=#ff0000]Original[/COLOR]")
    Set sh2 = Sheets("[COLOR=#ff0000]Summary[/COLOR]")
    sh2.Cells.ClearContents
    lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
    If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
    sh1.Range("A2:E" & lr).AutoFilter Field:=5, Criteria1:=">0"
    sh1.Range("A2:E" & lr).AutoFilter Field:=2, Criteria1:="<>Subtotal"
    sh1.Range("A2:A" & lr & ",E2:E" & lr).Copy
    sh2.Range("A1").PasteSpecial xlPasteValues
    sh1.ShowAllData
    lr = sh2.Range("B" & Rows.Count).End(xlUp).Row
    sh2.Cells(lr + 1, "A").Value = "Total"
    sh2.Cells(lr + 1, "B").Value = WorksheetFunction.Sum(sh2.Range("B2:B" & lr))
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work ("Summary"), select view code & paste the code into the window that opens up.

 

[chiron]

Hi, Try the following vba code in your sheet "summary", it's very simple. Each time you select the sheet the data is updated automatically.

Change data in red by your information.

Private Sub Worksheet_Activate()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = Sheets("[COLOR=#ff0000]Original[/COLOR]")
    Set sh2 = Sheets("[COLOR=#ff0000]Summary[/COLOR]")
    sh2.Cells.ClearContents
    lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
    If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
    sh1.Range("A2:E" & lr).AutoFilter Field:=5, Criteria1:=">0"
    sh1.Range("A2:E" & lr).AutoFilter Field:=2, Criteria1:="<>Subtotal"
    sh1.Range("A2:A" & lr & ",E2:E" & lr).Copy
    sh2.Range("A1").PasteSpecial xlPasteValues
    sh1.ShowAllData
    lr = sh2.Range("B" & Rows.Count).End(xlUp).Row
    sh2.Cells(lr + 1, "A").Value = "Total"
    sh2.Cells(lr + 1, "B").Value = WorksheetFunction.Sum(sh2.Range("B2:B" & lr))
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work ("Summary"), select view code & paste the code into the window that opens up.

Thanks. This is exactly what I was looking for. I'm having a hard time trying to understand how the PowerQuery solution works but I think I will be able to adapt this to my sheets.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.