ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA Program to calculate Subtotals (https://www.excelbanter.com/excel-programming/385232-vba-program-calculate-subtotals.html)

John C[_2_]

VBA Program to calculate Subtotals
 


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

VBA Program to calculate Subtotals
 
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.

--
Regards

Roger Govier


"John C" <johncAAATTlamberteng.com wrote in message
...


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











John C[_2_]

VBA Program to calculate Subtotals
 
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" wrote in message
...
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.

--
Regards

Roger Govier


"John C" <johncAAATTlamberteng.com wrote in message
...


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

VBA Program to calculate Subtotals
 
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.

--
Regards

Roger Govier


"John C" <johncAAATTlamberteng.com wrote in message
...
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" wrote in message
...
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.

--
Regards

Roger Govier


"John C" <johncAAATTlamberteng.com wrote in message
...


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
















All times are GMT +1. The time now is 05:39 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com