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!

 

[Snakehips]

@llbac !!! In the above, post, #10, I inadvertently copied the code with which I tested the error handling, by getting lr form an empty column 4 !!!

Please correct by editing the line to reference column A, (1) ....

 lr = sht.Cells(Rows.Count, 1).End(xlUp).Row      '<<< 1 = column A  Edit for another column if A not applicable

 

[llbac]

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.

I can confirm that all conditions you mentioned are correct.
However, I got message: "Check that your first data sheet has data rows in column A"
I have copied and pasted data to another workbook with only 2 sheets to check, but the result is the same with that message.
Here is my real data in my example workbook (I just copied 7 rows in this example)

Book1
	A	B
1	Column2	Column22
2	93.7403	0.908611
3	94.4648	0.908611
4	105.5086	0.908611
5	32.7153	0.908611
6	38.7466	0.908611
7	37.6211	0.908611
8	-1.929	0.908611
AhjfaweDb

Book1
	A	B
1	Column2	Column22
2	93.7913	0.829509
3	94.4113	0.829509
4	105.4699	0.829509
5	32.8098	0.829509
6	38.7472	0.829509
7	37.5898	0.829509
8	-1.8211	0.829509
Dxoawe98

 

[llbac]

@llbac !!! In the above, post, #10, I inadvertently copied the code with which I tested the error handling, by getting lr form an empty column 4 !!!

Please correct by editing the line to reference column A, (1) ....

 lr = sht.Cells(Rows.Count, 1).End(xlUp).Row      '<<< 1 = column A  Edit for another column if A not applicable

I have changed the code to 1, but the same message appeared

Hear is the code:

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, 1).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

 

[Snakehips]

I'm a bit baffled.
Running that code on that data here resets in the below result

Book3
	A
1	My Result
2	162.974184
3	164.146768
4	183.354493
5	56.941502
6	67.3467336
7	65.3640183
8	-3.2633293
9
Master

Can you add a line to message the value you are getting for lr and see what it is?
It should of course equal the last row of your data.

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, 1).End(xlUp).Row      '<<< 1 = column A  Edit for another column if A not applicable

MsgBox lr  '**for diagnostics

            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

 

[llbac]

I'm a bit baffled.
Running that code on that data here resets in the below result

Book3
	A
1	My Result
2	162.974184
3	164.146768
4	183.354493
5	56.941502
6	67.3467336
7	65.3640183
8	-3.2633293
9
Master

Can you add a line to message the value you are getting for lr and see what it is?
It should of course equal the last row of your data.

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, 1).End(xlUp).Row      '<<< 1 = column A  Edit for another column if A not applicable

MsgBox lr  '**for diagnostics

            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

Really, I am so confused

The message show number 1
Here is the code:

Sub cal_sum_NMR_Boltz()
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, 1).End(xlUp).Row      '<<< 1 = column A  Edit for another column if A not applicable
            MsgBox lr '**for diagnostics
            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

 

[Snakehips]

Again your code works fine here and returns lr as 8 for that trial data.
I am baffled and it is now beyond my bedtime.
Is there something odd about the data you have in column A that is screwing up the return for lr ?
Maybe link me to the file you are testing on and I will take a look tomorrow.

 

[llbac]

Again your code works fine here and returns lr as 8 for that trial data.
I am baffled and it is now beyond my bedtime.
Is there something odd about the data you have in column A that is screwing up the return for lr ?
Maybe link me to the file you are testing on and I will take a look tomorrow.

Yes, sure, here is the file I uploaded: Book1
Thank you very much and have a good night!

 

[Snakehips]

See if setting lr to a value known to be in excess of your max likely data rows works.
It will / should, return 0 in any of the excess result rows.

Goog Night!!!!!!!

Sub cal_sum_NMR_Boltz()
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 = 1000 '*** or edit to a value that is in excess of your max depth of data
        
            ''lr = sht.Cells(Rows.Count, 1).End(xlUp).Row      '<<< 1 = column A  Edit for another column if A not applicable
            ''MsgBox lr '**for diagnostics
            
            
            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

 

[llbac]

See if setting lr to a value known to be in excess of your max likely data rows works.
It will / should, return 0 in any of the excess result rows.

It returns zero from the row 2 all the way down to 1000, only the first row is blank.
See you tomorrow!

 

[llbac]

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.

I read again your instruction, then I realized that I missed the step "create a name which is sheetname".
After trying again, it showed error "Blocked".

The file I used as an example was uploaded here: Book1
I attached all related errors images, hope it is clear. (I am sorry, it is really long page)