Subscript out of range error looping through worksheets for table creation

Question

Code runs on first worksheet but throws an error on the next.

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 them. The code runs on sheetA but on sheetB throws

subscript out of range

Is it because, "Growth Table" already exists on sheet A?

Answer 1

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