Calculate values across the sheets in a workbook.

llbac · Jul 23, 2023

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:

Excel Formula:

=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

3

4

5

6

Master

Cell Formulas
Range	Formula
A2:A6	A2	=SheetA!A2SheetA!B2+SheetB!A2SheetB!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 · Jul 24, 2023

@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) ....

VBA Code:

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

llbac · Jul 24, 2023

Snakehips said:
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 · Jul 24, 2023

Snakehips said:
@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) ....

VBA Code:

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:

VBA 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 · Jul 24, 2023

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.

VBA 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

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 · Jul 24, 2023

Snakehips said:

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.

VBA 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

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:

VBA 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 · Jul 24, 2023

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 · Jul 24, 2023

Snakehips said:
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 · Jul 24, 2023

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!!!!!!!

VBA 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 = 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 · Jul 24, 2023

Snakehips said:
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 · Jul 24, 2023

keda duck said:
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)