VBA to RENAME multiple TABLES in one go, from a list of 'CURRENT' and 'NEW' names

[novabond]

hello,

I am hoping that someone (much smarter than me!) has code to share, which will allow me to automatically change multiply tables names, throughout a workbook, in one go, based on information that I would enter/list in a worksheet within that workbook, under header cells say:
A1 (original table name)
B1 (new table name)
I have managed to find code that will magic a worksheet with all the current table names listed, I now need the code which will rename them.... and because there are so many, I need the criteria to be from ranges within a worksheet.

In addition, apart from the usual find/replace tool, is there a way I can automatically update formulas, within a worksheet or entire workbook, which reference tables whereby the names have changed, so that they update too.... in order for the formulas to still work?

Thank you in advance!

Best
BNOVA

 

[BSALV]

novabond

Sub renommer()
     a = Range("Tabel1").Value

     For i = 1 To UBound(a)
          Sheets(CStr(a(i, 1))).Name = "@#_" & Format(i, "000")
     Next

     For i = 1 To UBound(a)
          Sheets("@#_" & Format(i, "000")).Name = a(i, 2)
     Next

End Sub

 

[novabond]

novabond

Sub renommer()
     a = Range("Tabel1").Value

     For i = 1 To UBound(a)
          Sheets(CStr(a(i, 1))).Name = "@#_" & Format(i, "000")
     Next

     For i = 1 To UBound(a)
          Sheets("@#_" & Format(i, "000")).Name = a(i, 2)
     Next

End Sub

hi, thank you for your reply... but unfortunately, i can't get it to work for me, by simply copying to clip board and pasting it in... (apologies if i have missed a step i need to do)...

when i run the macro as it is, i get the attached error...

TIA

 

[novabond]

novabond

Sub renommer()
     a = Range("Tabel1").Value

     For i = 1 To UBound(a)
          Sheets(CStr(a(i, 1))).Name = "@#_" & Format(i, "000")
     Next

     For i = 1 To UBound(a)
          Sheets("@#_" & Format(i, "000")).Name = a(i, 2)
     Next

End Sub

btw... i noticed that i read your script as table11 therefore, i had named my table incorrectly before running the macro, i updated it and ran again, and it did get further this time but, unfortunately it still stopped at the attached... TIA again.....

 

[BSALV]

if you add an "on error resume next", the macro 'll not stop if the sheetname isn't right, so the sheets that aren't renamed, check their spelling.
The macro renames the sheets first with a strange name and afterwards replace that name by the wanted name. That's to be sure that there aren't old names and new names the same at the same time.

Sub renommer()
     a = Range("Tabel1").Value

     On Error Resume Next

     For i = 1 To UBound(a)
          Sheets(CStr(a(i, 1))).Name = "@#_" & Format(i, "000")
     Next

     For i = 1 To UBound(a)
          Sheets("@#_" & Format(i, "000")).Name = CStr(a(i, 2))
     Next

End Sub

 

[novabond]

if you add an "on error resume next", the macro 'll not stop if the sheetname isn't right, so the sheets that aren't renamed, check their spelling.
The macro renames the sheets first with a strange name and afterwards replace that name by the wanted name. That's to be sure that there aren't old names and new names the same at the same time.

Sub renommer()
     a = Range("Tabel1").Value

     On Error Resume Next

     For i = 1 To UBound(a)
          Sheets(CStr(a(i, 1))).Name = "@#_" & Format(i, "000")
     Next

     For i = 1 To UBound(a)
          Sheets("@#_" & Format(i, "000")).Name = CStr(a(i, 2))
     Next

End Sub

thank you BSALY, yep that macro works great now, for changing worksheet names, and works through even if no names have changed however, i think perhaps i didn't explain very well, what i need the macro to do in the first place l, as it is Table Names that i want to be able to bulk change, not worksheet names.... my workbook has lots of tables over lots of worksheets, i want to be able to update a list containing CURRENT and CHANGE_TO Table names, and have a macro to run and update the name of the tables, reflected in the list......

 

[Akuini]

my workbook has lots of tables over lots of worksheets, i want to be able to update a list containing CURRENT and CHANGE_TO Table names, and have a macro to run and update the name of the tables, reflected in the list......

Try this on a copy of your workbook:
Say, the list is in Sheet1, start at A2:B2 downward:

Sub novabond()

Dim ws As Worksheet
Dim d As Object
Dim tbl As ListObject
Dim va, i As Long

With Sheets("Sheet1")
    va = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 2).Value
End With

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

For i = 1 To UBound(va, 1)
    d(va(i, 1)) = va(i, 2)
Next

        For Each ws In ActiveWorkbook.Worksheets
            For Each tbl In ws.ListObjects
                If d.Exists(tbl.Name) Then
                    tbl.Name = d(tbl.Name)
                End If
            Next tbl
        Next ws

End Sub

In addition, apart from the usual find/replace tool, is there a way I can automatically update formulas, within a worksheet or entire workbook, which reference tables whereby the names have changed, so that they update too.... in order for the formulas to still work?

if the above code works then I'll try to write a code for this part.

 

[igold]

How about this...
I put the Old Table Name and the New Table Name on a Worksheet named ("ChangeName") (please change code to suit your needs), starting in Cell A1 for the Original Name and Cell B1 with the New Name.
All the formulas that reference the Old Table Name should automatically update with the New Table Name... Please test on a backup of your worksheet.

Sub findtbls()

    Dim arr
    Dim wsCN As Worksheet: Set wsCN = Worksheets("ChangeName")
    Dim wss As Object, ws As Worksheet
    Dim tbls As Long, tbl As Long, i As Long, lRow As Long
   
    lRow = wsCN.Cells(Rows.Count, 2).End(xlUp).Row
    arr = wsCN.Range("A1:B" & lRow)
    Set wss = Worksheets
    For Each ws In wss
        If Not ws.ListObjects.Count = 0 Then
            For tbl = 1 To ws.ListObjects.Count
                For i = 1 To UBound(arr)
                    If ws.ListObjects(tbl).Name = arr(i, 1) Then
                        ws.ListObjects(tbl).Name = arr(i, 2)
                    End If
                Next
            Next
        End If
    Next
    MsgBox "Operation Complete"
   
End Sub

 

[novabond]

Try this on a copy of your workbook:
Say, the list is in Sheet1, start at A2:B2 downward:

Sub novabond()

Dim ws As Worksheet
Dim d As Object
Dim tbl As ListObject
Dim va, i As Long

With Sheets("Sheet1")
    va = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 2).Value
End With

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

For i = 1 To UBound(va, 1)
    d(va(i, 1)) = va(i, 2)
Next

        For Each ws In ActiveWorkbook.Worksheets
            For Each tbl In ws.ListObjects
                If d.Exists(tbl.Name) Then
                    tbl.Name = d(tbl.Name)
                End If
            Next tbl
        Next ws

End Sub

if the above code works then I'll try to write a code for this part.

Thank you so much this is stunning and runs super quickly.... you will notice igold also shared some code, this works great too.. and incorporates the second part too, so looks like i am all set... although... see my NAMED RANGE addition further down...

 

[novabond]

How about this...
I put the Old Table Name and the New Table Name on a Worksheet named ("ChangeName") (please change code to suit your needs), starting in Cell A1 for the Original Name and Cell B1 with the New Name.
All the formulas that reference the Old Table Name should automatically update with the New Table Name... Please test on a backup of your worksheet.

Sub findtbls()

    Dim arr
    Dim wsCN As Worksheet: Set wsCN = Worksheets("ChangeName")
    Dim wss As Object, ws As Worksheet
    Dim tbls As Long, tbl As Long, i As Long, lRow As Long
  
    lRow = wsCN.Cells(Rows.Count, 2).End(xlUp).Row
    arr = wsCN.Range("A1:B" & lRow)
    Set wss = Worksheets
    For Each ws In wss
        If Not ws.ListObjects.Count = 0 Then
            For tbl = 1 To ws.ListObjects.Count
                For i = 1 To UBound(arr)
                    If ws.ListObjects(tbl).Name = arr(i, 1) Then
                        ws.ListObjects(tbl).Name = arr(i, 2)
                    End If
                Next
            Next
        End If
    Next
    MsgBox "Operation Complete"
  
End Sub

thank you so much!... the code is wonderful and works perfectly... so perfectly infract, it made me think of something... see my NAMED RANGE addition next in this feed...