Receiving Error when trying to run macro on multiple sheets using VBA - excel

Question

I have the below macro that should be running on each sheet in my workbook. When I run this code, I am getting the following error: 'A table cannot overlap another table' and it is highlighting this line:
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$I"), , xlYes).Name = _
"Table1"
Is this because I applied the macro to table one and now it cannot be applied to the other tables?
All sheets have the same column headers but different number of rows (not sure if that matters). Essentially all I am trying to do is get rid of the index, format the data into a table, extend the column lengths to fit all the column names, and rename the columns.
Another thing to note, there are about 170 sheets that this macro needs to run through.
Sub forEachWs()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call CreateTables(ws)
Next
End Sub
Sub CreateTables(ws As Worksheet)
'
' CreateTables Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
With ws
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:I").Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$I"), , xlYes).Name = _
"Table1"
Columns("A:I").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight1"
Columns("A:I").EntireColumn.AutoFit
Range("Table1[[#Headers],[Tier2_ID]]").Select
ActiveCell.FormulaR1C1 = "Community ID"
Range("Table1[[#Headers],[Tier2_Name]]").Select
ActiveCell.FormulaR1C1 = "Community Name"
Range("Table1[[#Headers],[Current_MBI]]").Select
ActiveCell.FormulaR1C1 = "Current MBI"
Range("Table1[[#Headers],[countMBI]]").Select
ActiveCell.FormulaR1C1 = "Cout"
Range("Table1[[#Headers],[Cout]]").Select
ActiveCell.FormulaR1C1 = "Count"
Range("Table1[[#Headers],[TotalEDVisits]]").Select
ActiveCell.FormulaR1C1 = "Total ED Visits"
Range("Table1[[#Headers],[EDtoIPTotal]]").Select
ActiveCell.FormulaR1C1 = "Total ED to Inpatient"
Range("Table1[[#Headers],[totalSev1to3]]").Select
ActiveCell.FormulaR1C1 = "Severity 1 to 3"
Range("Table1[[#Headers],[totalSev4to6]]").Select
ActiveCell.FormulaR1C1 = "Severity 4 to 6"
Range("Table1[[#Headers],[totalPaid]]").Select
ActiveCell.FormulaR1C1 = "Total Paid"
Range("L22").Select
End With
End Sub

Answer 1

Convert Ranges to Tables
The table names in a workbook have to be unique.
This code (re)names each table sequentially i.e. Table1, Table2, Table3....
This is a one-time operation code, so test it first on a copy of your workbook.
If (when) you're satisfied with the outcome, run it in your original workbook.
Now the code is no longer needed (useless).
If you really need to select the cell L22 on each worksheet, you have to make sure the workbook is active (in the first code use If Not wb Is ActiveWorkbook Then wb.Activate).
In the second code, you can then use Application.Goto ws.Range("L22") right before (above) the last 'Else.
Sub ConvertToTables()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet
Dim n As Long
For Each ws In wb.Worksheets
n = n + 1 ' to create Table1, Table2, Table3...
ConvertToTable ws, "Table", n
Next
End Sub
Sub ConvertToTable( _
ByVal ws As Worksheet, _
ByVal TableBaseName As String, _
ByVal TableIndex As Long)
'
' CreateTables Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
' Note that all column names have to be unique i.e. you cannot
' rename the 'countMBI' column to 'Cout' before the existing 'Cout' column
' has been renamed.
Const OldColsList As String _
= "Tier2_ID,Tier2_Name,Current_MBI,Cout," _
& "countMBI,TotalEDVisits,EDtoIPTotal,totalSev1to3," _
& "totalSev4to6,totalPaid"
Const NewColsList As String _
= "Community ID,Community Name,Current MBI,Count," _
& "Cout,Total ED Visits,Total ED to Inpatient,Severity 1 to 3," _
& "Severity 4 to 6,Total Paid"
Const FirstCellAddress As String = "A1"
' Reference the first cell ('fCell').
Dim fCell As Range: Set fCell = ws.Range(FirstCellAddress)
' Check if the first cell is part of a table ('tbl').
' A weak check whether the table has already been created.
Dim tbl As ListObject: Set tbl = fCell.ListObject
If tbl Is Nothing Then ' the first cell is not part of a table
' Reference the range ('rg').
Dim rg As Range: Set rg = fCell.CurrentRegion
' Delete the first column. Note that the range has shrinked by a column.
rg.Columns(1).Delete xlShiftToLeft
' Convert the range to a table ('tbl').
Set tbl = ws.ListObjects.Add(xlSrcRange, rg, , xlYes)
With tbl
.Name = TableBaseName & CStr(TableIndex)
.TableStyle = "TableStyleLight1"
' Write the lists to string arrays ('OldCols', 'NewCols')
Dim OldCols() As String: OldCols = Split(OldColsList, ",")
Dim NewCols() As String: NewCols = Split(NewColsList, ",")
Dim lc As ListColumn
Dim n As Long
' Loop through the elements of the arrays...
For n = 0 To UBound(OldCols)
' Attempt to reference a table column by its old name.
On Error Resume Next
Set lc = .ListColumns(OldCols(n))
On Error GoTo 0
' Check if the column reference has been created.
If Not lc Is Nothing Then ' the column exists
lc.Name = NewCols(n) ' rename the column
Set lc = Nothing ' reset to reuse in the next iteration
'Else ' the column doesn't exist; do nothing
End If
Next n
' The columns should be autofitted after their renaming.
.Range.EntireColumn.AutoFit
End With
'Else ' the first cell is part of a table; do nothing
End If
End Sub