VBA Program to calculate Subtotals

[John C]

I have tried different methods to achieve this (pivot tables etc) but I
don't get the required result in the right format.



I have a workbook with the first Sheet named "Totals". The rest of the
worksheets "Sheet2, Sheet3 ..etc" have a description in "Column A" and a
quantity in "Column B"



Example:-



"Sheet 2"

Col A ----- Col B

ITEM01 ----- 2

ITEM03 ----- 1

ITEM01 ----- 2

ITEM02 ----- 5

ITEM06 ----- 0

ITEM05 ----- 10



"Sheet 3"

ITEM01 ----- 1

ITEM02 ----- 1

ITEM05 ----- 2

ITEM04 ----- 2



I require a macro to compare the descriptions and add the quantities of each
description and show the summary on the totals page. The following needs to
be taken into account.

a) New worksheets might be added so the macro wants to look in every
worksheet apart from the first one "Totals"

b) If the description has a quantity of 0 it wants to be ignored and not
added to the Totals page.



When running the macro I would like to see the following results on the
Totals page.

"Totals"

ITEM01 ----- 5

ITEM02 ----- 6

ITEM03 ----- 1

ITEM04 ----- 2

ITEM05 ----- 12



Like I mentioned I have used pivot tables but the format in inappropriate
and new worksheets might be added, also I want this user friendly.

Has anyone done anything like this before, this macro would be very useful
to much appreciated.



Thanks

John

 

[Roger Govier]

Hi John

Create a new Sheet called Summary
Leave Column A blank
In column B enter your list of Items, ITEM01, ITEM02 etc.
In column C, enter
=SUMPRODUCT(SUMIF(INDIRECT("'"&Snames&"'!A:A"),
C1,INDIRECT("'"&Snames&"'!B:B")))
and copy down as far as you have items listed.

Copy the following macro to the workbook

Sub ListSheets()
Dim ws As Worksheet, i As Long

For Each ws In Worksheets
If ws.Name <> "Summary" Then
i = i + 1
Sheets("Summary").Cells(i, 1) = ws.Name
End If
ActiveWorkbook.Names.Add Name:="Snames", RefersToR1C1:= _
Sheets("Summary").Range(Cells(1, 1), Cells(i, 1))
Next

End Sub

This will create a list of sheet names which are then used as Snames in
the INDIRECT() portion of the formula as above.
Run the macro after you have added any sheets, and your formula will
adjust to give the correct totals.

 

[John C]

Hi Roger,

Thankyou for taking the time reply, I have followed your instructions but
get a "Run-time error `1004' " when stepping through the macro getting to
the line above next. Just running the macro displays a red cross with 400 in
it. I'm using Office 2000 I'm afraid.

Thanks again
John

 

[Roger Govier]

Hi John

Sloppy coding on my part I'm afraid.
I will run OK if Summary is the Active sheet when you run the macro.

I had stupidly put the creation of the Named range inside the loop,
causing it to be activated each time a new sheet name was added.
I have now moved it outside the loop, and ensured that Summary is
activated before creating the Named range so it doesn't matter what
sheet you are on when you run the macro

Sub ListSheets()
Dim ws As Worksheet, i As Long

For Each ws In Worksheets
If ws.Name <> "Summary" Then
i = i + 1
Sheets("Summary").Cells(i, 1) = ws.Name
End If
Next
Sheets("Summary").Activate
ActiveWorkbook.Names.Add Name:="Snames", RefersToR1C1:= _
Sheets("Summary").Range(Cells(1, 1), Cells(i, 1))

End Sub

My apologies for such poor coding.