Home > database >  VBA Embed Loop within a Loop
VBA Embed Loop within a Loop

Time:12-22

I'm trying to embed a loop within a loop. I have a workbook with multiple worksheets. What I'm trying to do is identify the range of each worksheet in my workbook and add an additional worksheet for each sheet to create a pivot table. I'm having trouble with embedding my For Loop for worksheet creation in the for loop of setting the worksheet ranges. My current code creates the pivot worksheets and the pivot tables but they all use the range of one worksheet only.

'set pivot table data range

 Dim sht As Worksheet
 Set wb = ActiveWorkbook
 For Each sht In ActiveWorkbook.Worksheets
    Set dataRG = sht.Range("A4").CurrentRegion
 Next 
'verify pvt table sheets in wb

 Dim SheetNames() As Variant
 SheetNames() = Array("Test1 Pivot", "Test2 Pivot", "Test3 
 Pivot", "Test4 Pivot", "Test5 Pivot", "Test6 Pivot", 
 "Test7 Pivot")

  For n = LBound(SheetNames) To UBound(SheetNames)
      Set pvtWs = Nothing  'reset ws to Nothing
      On Error Resume Next  'ignore errors
      Set pvtWs = wb.Worksheets(SheetNames(n)) 'try to set `ws`
      On Error GoTo 0          'stop ignoring errors
      If pvtWs Is Nothing Then 'add a sheet
         Set pvtWs = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
         pvtWs.Name = SheetNames(n)
         
         'pivot cache and create pivot
         Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:-xlDatabase,SourceData:=dataRG)
         Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=pvtWs.Cells(1,1))
         pvtTable.Name = PvtNames(n)
      End If
  Next

CodePudding user response:

It would be cleaner to loop over a list of data sheet names, and use that to drive the logic.

So something like this (untested):

Option Explicit

Sub CheckPivots()

    Dim wb As Workbook, nm, wsPivot As Worksheet, wsData As Worksheet
    Dim SheetNames, pvNm, pvtCache As PivotCache, pvtTable As PivotTable
    Dim rngData As Range
    
    'The names of your sheets with data
    SheetNames = Array("Team1", "Team2", "Team3", _
                   "Team4", "Team5", "Team6", "Team7")
    
    Set wb = ActiveWorkbook
    For Each nm In SheetNames
        Set wsData = GetSheet(wb, nm)
        If Not wsData Is Nothing Then 'data sheet exists?
            pvNm = nm & " Pivot"      'name for the pivot sheet
            Set wsPivot = GetSheet(wb, pvNm)
            If wsPivot Is Nothing Then 'need to add a pivot sheet?
                Set wsPivot = wb.Worksheets.Add(after:=wsData)
                wsPivot.Name = pvNm
                'pivot cache and create pivot
                Set rngData = wsData.Range("A4").CurrentRegion
                Set pvtCache = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData)
                Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=wsPivot.Cells(1, 1))
                pvtTable.Name = "pt_" & nm 'based on source data sheet name
            End If
        End If
    Next nm    'next data sheet name
End Sub

'Return worksheet `nm` from workbook `wb`, or Nothing if no sheet with that name
Function GetSheet(wb As Workbook, wsName) As Worksheet
    On Error Resume Next
    Set GetSheet = wb.Worksheets(wsName)
End Function
  • Related