Calculate values across the sheets in a workbook.

[llbac]

Hi everyone,

Could anyone please tell me how to write a VBA to do this simple task (but not easy for me ^^!, sadly)?
I have a workbook that contains many sheets (maybe 30 sheets or more) which their names are quite random.
Then I will create a sheet named Master and calculate very simple formular like this:

=SheetA!A2*SheetA!B2+SheetB!A2*SheetB!B2+SheetC!A2*SheetC!B2..........

That is the sum of all the multiplication of two cells of two column (A & B) on the same row (e.g. A2 * B2), for all of the sheets available on the workbook.
All the sheets I want to calculate have the same structure: column A and B with number, start from row 2. Also, the number of rows is the same in every sheets.
This is the samples in XL2BB:
SheetA:

Fomular-test-3.xlsm
	A	B
1	Title A	Title B
2	0.537552278	0.3560159
3	0.728059909	0.0117653
4	0.231946094	0.8570487
5	0.369968555	0.7705613
6	0.451232307	0.9802114
SheetA

SheetB:

Fomular-test-3.xlsm
	A	B
1	Title A	Title B
2	0.801403328	0.398481
3	0.654761892	0.415879
4	0.887848563	0.7809355
5	0.096687559	0.1760872
6	0.897179486	0.115832
SheetB

SheetC:

Fomular-test-3.xlsm
	A	B
1	Title A	Title B
2	0.93357177	0.5453227
3	0.428093125	0.8806354
4	0.219500915	0.6875302
5	0.310767214	0.3542
6	0.038372637	0.9443508
SheetC

The sheet Master I want to calculate from all other sheets:

Fomular-test-3.xlsm
	A
1	Across
2	1.019819025
3	0.657861573
4	1.043055101
5	0.41218262
6	0.582462382
Master

Cell Formulas
Range	Formula
A2:A6	A2	=SheetA!A2*SheetA!B2+SheetB!A2*SheetB!B2+SheetC!A2*SheetC!B2

The structure is simple but when typing for too many sheets, usually mistakes happened then it will be a huge problem for my final result.
The point here is that:
The code should calculate all available sheets without knowing sheets' names, and paste to the current active sheet (e.g. Master).
Really appreciate your help!

 

[PeteWright]

There are two names in Excel VBA, the displayed name (RED) and the "code name" (GREEN) name, see picture below.

You could work with that, but keep one thing in mind:
The "internal" name will be created and numbered automatically with each new sheet like this:

New workbook created will have both the same "Sheet1"
New worksheet will be "Sheet2" and the "code name" name won't change (unless you do so)
-> When you change the "displayed" name to "NameX", "NameY" and "NameZ", the "code name" names will still be "Sheet1", "Sheet2" and "Sheet3" in order of creation.

There's a good tutorial on Excel Sheet Names here automateexcel.com and automateexcel.com

If the numer of sheets you want to calculate is the same as the number of sheets available in your workbook minus the Master Sheet:
-> 3 Sheets plus 1 Master Sheet: "Master", "SheetA", "SheetB", "SheetC"

Then you need to look up the "Code Name" of your "Master" Sheet and the other sheets and see if their naming is "continuous"

If it is, you're ready to go.
-> e.g. "Master" = "Sheet1", "SheetA" = "Sheet2", "SheetB" = "Sheet3", "SheetC" = "Sheet4", etc.

Then your code would look like this:

Sheet2.Range ("A2") * Sheet2.Range("B2") + Sheet3.Range("A2") * Sheet3.Range("B2") + Sheet4.Range("A2") * Sheet4.Range("B2")

etc.

But with a big number of sheets your code will be very long and you should consider to "loop through" your sheets rather then addressing one by one.

In Order to get a VBA code I need a few more information on your data or input:
How many rows are there per sheet? Is it always row 2 to row 6?

Hope it helps a little bit.
Please tell me more about your data.

 

[keda duck]

textt.xlsx
	A	B	C	D
1	across			SheetA
2	1.019819025	1.019819025		SheetB
3	0.657861573	0.657861573		SheetC
4	1.043055101	1.043055101
5	0.41218262	0.41218262
6	0.582462382	0.582462382
master

Cell Formulas
Range	Formula
A2:A6	A2	=SheetA!A2*SheetA!B2+SheetB!A2*SheetB!B2+SheetC!A2*SheetC!B2
B2:B6	B2	=SUM(REDUCE({""},$D$1:$D$3,LAMBDA(x,y,VSTACK(x,INDIRECT(y&"!r"&ROW()&"c1",)*INDIRECT(y&"!r"&ROW()&"c2",)))))

In this solution, you should write the sheet name in column d.

 

[Snakehips]

@llbac Assuming that the sheet 'Master' exists then, maybe like below with vba.

Sub llbac()
Dim arr As Variant, res As Variant
Dim lr As Long, mlr As Long

For Each sht In ThisWorkbook.Sheets
    If Not sht.Name = "Master" Then
        If Not lr > 1 Then
            lr = sht.Cells(Rows.Count, 1).End(xlUp).Row
            ReDim arr(1 To lr - 1, 1 To 1)
            ReDim res(1 To lr - 1)
        End If
    arr = sht.Range("A2:B" & lr).Value
        For c = 1 To lr - 1
            res(c) = res(c) + (arr(c, 1) * arr(c, 2))
        Next c
    End If
Next sht
With Sheets("Master")
    mlr = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("A2:A" & mlr).ClearContents
    .Range("A2:A" & lr).Value = Application.Transpose(res)
End With
End Sub

Hope that helps.

 

[llbac]

There are two names in Excel VBA, the displayed name (RED) and the "code name" (GREEN) name, see picture below.

View attachment 95780
You could work with that, but keep one thing in mind:
The "internal" name will be created and numbered automatically with each new sheet like this:

New workbook created will have both the same "Sheet1"
New worksheet will be "Sheet2" and the "code name" name won't change (unless you do so)
-> When you change the "displayed" name to "NameX", "NameY" and "NameZ", the "code name" names will still be "Sheet1", "Sheet2" and "Sheet3" in order of creation.

There's a good tutorial on Excel Sheet Names here automateexcel.com and automateexcel.com

If the numer of sheets you want to calculate is the same as the number of sheets available in your workbook minus the Master Sheet:
-> 3 Sheets plus 1 Master Sheet: "Master", "SheetA", "SheetB", "SheetC"

Then you need to look up the "Code Name" of your "Master" Sheet and the other sheets and see if their naming is "continuous"

If it is, you're ready to go.
-> e.g. "Master" = "Sheet1", "SheetA" = "Sheet2", "SheetB" = "Sheet3", "SheetC" = "Sheet4", etc.

Then your code would look like this:

Sheet2.Range ("A2") * Sheet2.Range("B2") + Sheet3.Range("A2") * Sheet3.Range("B2") + Sheet4.Range("A2") * Sheet4.Range("B2")

etc.

But with a big number of sheets your code will be very long and you should consider to "loop through" your sheets rather then addressing one by one.

In Order to get a VBA code I need a few more information on your data or input:
How many rows are there per sheet? Is it always row 2 to row 6?

Hope it helps a little bit.
Please tell me more about your data.

Yes, "loop through" is exactly what I supposed to do with VBA, because the number of sheets varies each case, usually more than 30.
The number of rows is also different each case, so it is hard to tell a specific number, perhaps about 60 rows, more or less.

I hope I made it clear.

 

[llbac]

textt.xlsx
	A	B	C	D
1	across			SheetA
2	1.019819025	1.019819025		SheetB
3	0.657861573	0.657861573		SheetC
4	1.043055101	1.043055101
5	0.41218262	0.41218262
6	0.582462382	0.582462382
master

Cell Formulas
Range	Formula
A2:A6	A2	=SheetA!A2*SheetA!B2+SheetB!A2*SheetB!B2+SheetC!A2*SheetC!B2
B2:B6	B2	=SUM(REDUCE({""},$D$1:$D$3,LAMBDA(x,y,VSTACK(x,INDIRECT(y&"!r"&ROW()&"c1",)*INDIRECT(y&"!r"&ROW()&"c2",)))))

In this solution, you should write the sheet name in column d.

Unfortunately, I am afraid of that typing more than 30 sheets, which their names are long and random, will be a bottleneck in my workflow if any typing errors occur. Also, I have a lot of workbooks to repeat this calculation again and again.
I suppose that the best approach for me is to cycle through all the sheets automatically without typing their names.
Anyway, I really appreciate your kind help!

 

[llbac]

@llbac Assuming that the sheet 'Master' exists then, maybe like below with vba.

Sub llbac()
Dim arr As Variant, res As Variant
Dim lr As Long, mlr As Long

For Each sht In ThisWorkbook.Sheets
    If Not sht.Name = "Master" Then
        If Not lr > 1 Then
            lr = sht.Cells(Rows.Count, 1).End(xlUp).Row
            ReDim arr(1 To lr - 1, 1 To 1)
            ReDim res(1 To lr - 1)
        End If
    arr = sht.Range("A2:B" & lr).Value
        For c = 1 To lr - 1
            res(c) = res(c) + (arr(c, 1) * arr(c, 2))
        Next c
    End If
Next sht
With Sheets("Master")
    mlr = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("A2:A" & mlr).ClearContents
    .Range("A2:A" & lr).Value = Application.Transpose(res)
End With
End Sub

Hope that helps.

I got error '9': Subscript out of range at line:

ReDim arr(1 To lr - 1, 1 To 1)

Could you please tell me how to solve this?

 

[keda duck]

Unfortunately, I am afraid of that typing more than 30 sheets, which their names are long and random, will be a bottleneck in my workflow if any typing errors occur. Also, I have a lot of workbooks to repeat this calculation again and again.
I suppose that the best approach for me is to cycle through all the sheets automatically without typing their names.
Anyway, I really appreciate your kind help!

If you want to write sheet name dynamically, a common approach is used name manager of formula in the menu bar. Create a name which is sheetname, its formula is =GET.WORKBOOK(1)&T(NOW()). You should put Master on the first one, and then you can use the formula of this mini-sheet.

textt.xlsx
	A	B	C	D
1	across			SheetA
2	1.019819025	1.019819025		SheetB
3	0.657861573	0.657861573		SheetC
4	1.043055101	1.043055101
5	0.41218262	0.41218262
6	0.582462382	0.582462382
master

Cell Formulas
Range	Formula
D1:D3	D1	=TRANSPOSE(DROP(MID(sheetname,FIND("]",sheetname)+1,99),,1))
A2:A6	A2	=SheetA!A2*SheetA!B2+SheetB!A2*SheetB!B2+SheetC!A2*SheetC!B2
B2:B6	B2	=SUM(REDUCE({""},D$1#,LAMBDA(x,y,VSTACK(x,INDIRECT(y&"!r"&ROW()&"c1",)*INDIRECT(y&"!r"&ROW()&"c2",)))))
Dynamic array formulas.

 

[llbac]

If you want to write sheet name dynamically, a common approach is used name manager of formula of menu. Create a name which is sheetname, its formula is =GET.WORKBOOK(1)&T(NOW()). You should put Master on the first one, and then you can use the formula of this mini-sheet.

textt.xlsx
	A	B	C	D
1	across			SheetA
2	1.019819025	1.019819025		SheetB
3	0.657861573	0.657861573		SheetC
4	1.043055101	1.043055101
5	0.41218262	0.41218262
6	0.582462382	0.582462382
master

Cell Formulas
Range	Formula
D1:D3	D1	=TRANSPOSE(DROP(MID(sheetname,FIND("]",sheetname)+1,99),,1))
A2:A6	A2	=SheetA!A2*SheetA!B2+SheetB!A2*SheetB!B2+SheetC!A2*SheetC!B2
B2:B6	B2	=SUM(REDUCE({""},D$1#,LAMBDA(x,y,VSTACK(x,INDIRECT(y&"!r"&ROW()&"c1",)*INDIRECT(y&"!r"&ROW()&"c2",)))))
Dynamic array formulas.

I got error 'NAME' at formular at D column:

CR28A_NMR_test-7-Final.xlsm
	D
1	#NAME?
Sheet1

Cell Formulas
Range	Formula
D1	D1	=TRANSPOSE(DROP(MID(sheetname,FIND("]",sheetname)+1,99),,-1))

Could please give me any further instruction?

 

[Snakehips]

@llbac That indicates to me that the row number for the last row of data, lr, is being computed as 1.
If so then the code will error when it attempts to dim the arrays with lr-1.
The code assumes that lr can be determined by the last row of data in column A of any sheet other than the Master sheet.
So it does this using the first data sheet it finds.

I have tweaked the code, below, so that in the case of such an error it will fail in a more controlled manner.
However, why is it failing?
Here are my interpretation of your original post.
A variable number of randomly named sheets all contain similarly structured data in columns A & B.
There is one other non-data sheet that is named 'Master' (Edit code if this sheet name differs) .
Sheet 'Master' is to receive results.
If any of the above is not correct then please advise as the code will need to reflect your reality.

Sub llbac()
Dim arr As Variant, res As Variant
Dim lr As Long, mlr As Long, c As Long
Dim sht As Worksheet

For Each sht In ThisWorkbook.Sheets
    If Not sht.Name = "Master" Then  '<<< Edit Master if name differs
        If Not lr > 1 Then
        On Error GoTo BailOut  'controled exit sub without failing
            lr = sht.Cells(Rows.Count, 4).End(xlUp).Row      '<<< 1 = column A  Edit for another column if A not applicable
            If Not lr > 1 Then MsgBox "Check that your first data sheet has data rows in column A"   '<<<<check if lr is being set correctly??????"
            ' if no data or only header row lr <= 1 then the following will error
            ReDim arr(1 To lr - 1, 1 To 1)
            ReDim res(1 To lr - 1)
        End If
    arr = sht.Range("A2:B" & lr).Value
        For c = 1 To lr - 1
            res(c) = res(c) + (arr(c, 1) * arr(c, 2))
        Next c
    End If
Next sht
With Sheets("Master")
    mlr = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("A2:A" & mlr).ClearContents
    .Range("A2:A" & lr).Value = Application.Transpose(res)
End With
BailOut:
On Error GoTo 0  'reset default error handling
End Sub