VBA:Subscript out of range error : For loop :multiple worksheets -Table creation

Question

VBA newbie: Code runs fine on 1st worksheet but throws an error on the rest

Dim st As Worksheet     
Set st = ActiveSheet 
  
  For Each ws In ThisWorkbook.Worksheets
     ws.Activate

  ''--------------------------------''
 'Print lables on worksheet'
 ''------------------------------''
 ws.Cells(2, 15).value = "Greatest_increase"
 ws.Cells(3, 15).value = "Greatest_decrease"
 ws.Cells(4, 15).value = "Greatest total"
 ws.Cells(1, 16).value = "name"
 ws.Cells(1, 17).value = "Value"


  'Print values on worksheet'
 ''------------------------------------------------------''
  ws.Range("P2").value = name1
  ws.Range("P3").value = name2
  ws.Range("P4").value = name3
  ws.Range("Q2").value = GreatIncrease
  ws.Range("Q3").value = GreatDecrease
  ws.Range("Q4").value = GreatTotal
 
 `'Create a table "Growth_Table" for range("O1:Q4")'
  '-----------------------------------------------------------------------''
  Dim tablename As String
  Dim TableExists As Boolean
  
  'tablename = "Growth_Table"      
   TableExists = False
  
On Error GoTo Skip
If ActiveSheet.ListObjects("Growth_Table").Name = "Growth_Table" Then
TableExists = True
End If
Skip:
    On Error GoTo 0
     
If Not TableExists And (ws.Range("O2").value = "Greatest_increase") Then
     
    ActiveSheet.ListObjects.Add(xlSrcRange, ws.Range("O1:Q4"), , xlYes).Name = "Growth_Table"
    ActiveSheet.ListObjects("Growth_Table").TableStyle = "TableStyleLight9"
     
Else
    Exit Sub
     
         End If
 

      Next 
st.Activate

Sheets are named A,B,C,D. I want to run the code for all the sheets by looping through.But code runs fine on sheetA but throws 'subscript out of range on sheetB. Is it because, "Growth Table" already exists on sheet A? Any fix?

Please Help!

First rewrite it so that it does not depend on `ActiveSheet` and `ws.Activate` - That's where most of these issues come from. Since you already have the worksheet object, you change change all the `ActiveSheet.ListObjects` to `ws.ListObjects` — braX, Jan 12 '21 at 04:55
`IndexOutOfRange` exceptions only happen when you exceed the bounds of an array or collection. Use the debugger to step through the code to find out where you're going past the end of that array or collection by assuming that something is there that isn't. — Ken White, Jan 12 '21 at 05:09

VBasic2008 · Accepted Answer · 2021-01-12T18:12:56.670

Add Table To Each Worksheet

Tested without writing values to worksheets.

The Code

Option Explicit

Sub addTables()
    
    Const tblName As String = "Growth_Table"
    Const tblAddress As String = "O1:Q4"
    Const tblStyle As String = "TableStyleLight9"
    
    Dim ash As Worksheet: Set ash = ActiveSheet
    
    Dim ws As Worksheet
    Dim tbl As ListObject
    
    For Each ws In ThisWorkbook.Worksheets
     
        'Write lables to worksheet
        ws.Range("O2").Value = "Greatest_increase"
        ws.Range("O3").Value = "Greatest_decrease"
        ws.Range("O4").Value = "Greatest total"
        ws.Range("P1").Value = "Name"
        ws.Range("Q1").Value = "Value"
        
        'Write values to worksheet
        ws.Range("P2").Value = name1
        ws.Range("P3").Value = name2
        ws.Range("P4").Value = name3
        ws.Range("Q2").Value = GreatIncrease
        ws.Range("Q3").Value = GreatDecrease
        ws.Range("Q4").Value = GreatTotal
         
        'Try to create a reference to (set) the table
        Set tbl = Nothing
        On Error Resume Next
        Set tbl = ws.ListObjects(tblName)
        On Error GoTo 0
     
        'Create table.
        If tbl Is Nothing Then 'Table does not exist
            Set tbl = ws.ListObjects.Add(xlSrcRange, _
                ws.Range(tblAddress), , xlYes)
            tbl.Name = tblName
            tbl.TableStyle = tblStyle
        'Else 'Table already exists
        End If
    
    Next ws
    
    ash.Activate

End Sub

VBA:Subscript out of range error : For loop :multiple worksheets -Table creation

1 Answers1

Add Table To Each Worksheet