VBA - Main worksheet to add values across other new not yet created worksheets across multilpe ranges

Question

I'm pretty new to VBA and love to challenge myself, but am at a loss on this project however.

I have a workbook that has quite a few tabs used for various calculations and summations. The "PDP Base" main tab takes all "PDP BaseX" tabs and adds all values for the same cell across all "PDP BaseX" tabs into the main one. This is easy to handle manually when there are only 5 or so "PDP BaseX" tabs, but if there are potentially many tabs to add together (10+), combing through each is a pain. This is made worse if there are multiple cases to add formulas to (PNP;PBP;PUD;PBL - with each having a Base and Sens modifier).

Each new "PDP BaseX" tab is copy pasted from a template ran by other code (not yet finished) with a new "X+1" value, and so I don't want to just copy paste a formula adding the new tab into the main tab.

The end result will have code for all the main tabs of each category, but if I can get one main tab to do what I want, I can go from there.

Below is some code that I feel is close, but it loops to infinity somewhere in there and won't move pass initial cell B29 (getting overflow into PDP Base B29 when result should be lets say 10 for example; PDP Base1 B29 = 2; PDP Base2 B29 = 6; PDP Base3 B29 = 4)

Private Sub Worksheet_Calculate()
Dim ws As Worksheet, mainws As Worksheet
Dim rng As Range, mainrng As Range
Dim x As Single, y As Single
Dim tVar As Double

Set mainws = ActiveWorkbook.Worksheets("PDP Base")

With mainws
 For y = 2 To 4
  For x = 29 To 43
   For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "PDP Base*" And ws.CodeName <> "PDPBase" Then 
              'the main tab has a codename assigned to it to not add itself
     With ws
      With .Range(Cells(x, y))
       tVar = tVar + .Range(Cells(x, y)).Value

      End With
     End With
    End If
   Next ws

  Set mainrng = Cells(x, y)
  mainrng.Value = tVar
  tVar = 0

 Next x
Next y
End With
End Sub

Would someone be able to shed some insight into this? Thank you!

Tim Williams · Accepted Answer

Untested but should do what you want:

Private Sub Worksheet_Calculate()

    Const MAIN_WS_NAME As String = "PDP Base" 'use a constant for fixed values

    Dim ws As Worksheet, mainws As Worksheet, wb As Workbook
    Dim x As Long, y As Long 'Long not Single
    Dim tVar As Double

    Set wb = ActiveWorkbook
    Set mainws = wb.Worksheets(MAIN_WS_NAME)

    For y = 2 To 4
        For x = 29 To 43
            tVar = 0
            For Each ws In wb.Worksheets
                If ws.Name Like MAIN_WS_NAME & "*" And ws.Name <> MAIN_WS_NAME Then
                    tVar = tVar + ws.Cells(x, y).Value
                End If
            Next ws
            mainws.Cells(x, y).Value = tVar
        Next x
    Next y

End Sub

VBA - Main worksheet to add values across other new not yet created worksheets across multilpe ranges

Answers (2)

Related Questions