Automatically rename all tables on a worksheet

[excelery]

Hi all!

I am trying to rename all the tables on a worksheet and understand that I need to use VBA to do so.. I'm not very experienced so I was wondering if I can get some help here. Basically the layout of the table is like this:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Name Part 1[/TD]
[TD]Name Part 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Column1[/TD]
[TD]Column2[/TD]
[TD]Column3[/TD]
[TD]Column4[/TD]
[TD]Column5[/TD]
[/TR]
[TR]
[TD]Row1
[/TD]
[TD]a[/TD]
[TD]a[/TD]
[TD]a[/TD]
[TD]a[/TD]
[/TR]
[TR]
[TD]Row2
[/TD]
[TD]a[/TD]
[TD]a[/TD]
[TD]a[/TD]
[TD]a[/TD]
[/TR]
</tbody>[/TABLE]

The bolded cells are part of one table object. The top row are not. Name Part 1 and Name Part 2 are dropdown lists and I'd like the name of the table object to automatically change whenever the Name Parts are updated, minus all spaces (for context, the worksheet will have multiple tables like this). In this example, the name of the table would be NamePart1NamePart2. Can I get help as to where to start or what the solution may look like?

Many thanks!

 

[gallen]

Hello and welcome.

The syntax to change a table's name is :

    Me.ListObjects("<[COLOR=#ff0000][B]CurrentTableName[/B][/COLOR]>").Name = "<[COLOR=#ff0000][B]NewTableName[/B][/COLOR]>"

HOwever it isn't that straight forward as you need to to know what is the current name of the table.

You have missed a little info out so I will have to assume a few things.

Assuming the Dropdowns are in Cells A1 and B1: This code needs to be in the sheet

Sub ChangeTableName()

Dim sCurrentTableName As String
Dim sNewTableName As String
    
    sNewTableName = WorksheetFunction.Clean(Range("A1") & Range("B1")) 'Concatenate A1 & B1 and remove any bad characters
    
    sCurrentTableName = GetTableName
    
    If sCurrentTableName <> "" Then Me.ListObjects(sCurrentTableName).Name = sNewTableName
    
End Sub

Function GetTableName() As String
    On Error Resume Next
        GetTableName = ActiveCell.Offset(1, 0).ListObject.Name 'Get Tablename of cell directly under B1
    On Error GoTo 0
End Function


Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$1" Then 'Only change table name if B1 changes
        ChangeTableName
    End If
    
End Sub

 

[excelery]

Hi gallen, thanks for your response!

Yes, it seems that I missed some info. The dropdowns are not always A1 and B1 as the worksheet has many of these tables that follow this template.

For example here: The first table is called Name1aName2a and the second table is called Another1aAnother2b. I will edit my first post

[TABLE="class: grid, width: 300"]
<tbody>[TR]
[TD]Name 1a[/TD]
[TD]Name 2a[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Col1
[/TD]
[TD]Col2
[/TD]
[TD]Col3
[/TD]
[/TR]
[TR]
[TD]Row1
[/TD]
[TD]X[/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD]Row2
[/TD]
[TD]X[/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD]Row3
[/TD]
[TD]X[/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD]Another 1a[/TD]
[TD]Another 2b[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Col1
[/TD]
[TD]Col2
[/TD]
[TD]Col3
[/TD]
[/TR]
[TR]
[TD]Row1
[/TD]
[TD]X[/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD]Row2
[/TD]
[TD]X[/TD]
[TD]X[/TD]
[/TR]
[TR]
[TD]Row3
[/TD]
[TD]X[/TD]
[TD]X[/TD]
[/TR]
</tbody>[/TABLE]

 

[gallen]

Then you are going to have detect whenever a user changes any of the dropdown addresses and then change the name:

Sub ChangeTableName(RightDropDown As Range)


Dim sCurrentTableName As String
Dim sNewTableName As String
    
    sNewTableName = WorksheetFunction.Clean(RightDropDown.Offset(0, -1) & RightDropDown) 'Concatenate both dropdowns
    
    sCurrentTableName = GetTableName
    
    If sCurrentTableName <> "" Then Me.ListObjects(sCurrentTableName).Name = sNewTableName
    
End Sub


Function GetTableName() As String
    On Error Resume Next
        GetTableName = ActiveCell.Offset(1, 0).ListObject.Name 'Get Tablename of cell directly under B1
    On Error GoTo 0
End Function




Private Sub Worksheet_Change(ByVal Target As Range)


    If Target.Cells.Count > 1 Then Exit Sub


Dim rRightDropDowns As Range 'This range will represent every address of the Right hand side drop down boxes


    'Just as example. You will need to enter every cell address that contains the righthand dropdown in the line of code below. _
    So this line assumes you have a dropdown in B1 and B6, you must change where neccessary
    Set rRightDropDowns = Union(Range("B1"), Range("B10"))
    
    'Now Check if the cell that has changed is one of those cells
    If Not Intersect(Target, rRightDropDowns) Is Nothing Then
        'If we get here then a righthand dropdown has changed
        ChangeTableName Target
    End If
    
End Sub

 

[tdh777]

Then you are going to have detect whenever a user changes any of the dropdown addresses and then change the name

I know this is 2 years old but I think there is a need to offer improvements to gallen's code for those who might be finding this thread later (as I did).

Generally whenever writing VBA code you should try an make it so that it continues to work even when the underlying workbook/worksheets are changed around (data is moved, columns or rows are are added etc). You should also try and write code that will **scale** - that is it will work whether there are 5 rows of data in your worksheet or 100,000.

gallen's code requires you to specify exactly the row numbers above where each of the tables start, and only works if the 2nd of the two cells making up the Table-name changes. Not only does this require a large amount of effort to set up (which could be hundreds of lines of code if there are hundreds of tables in the worksheet) but it will cease to function properly as soon as one row is added to any of the tables (except the last ).

Therefore, here is some modified code that will work no matter where the tables are positioned on the worksheet, no matter how many there are, and no matter how many rows are in each of the individual tables. The only thing required to make this code achieve the desired outcome is that the tables conform to the pattern explained by the OP : 2 cells immediately above the left 2 columns of each table containing the 2 parts of the desired new TableName.

Private Sub ChangeTableName(sCurrentTableName As String)
    ' Change the name of an existing Table to the combined name from the 2 cells immediately above.
    Dim sNewTableName As String, FirstTableCell As Range

    If sCurrentTableName <> "" Then

        Set FirstTableCell = ActiveSheet.ListObjects(sCurrentTableName).Range.Cells(1, 1)
        sNewTableName = WorksheetFunction.Clean(FirstTableCell.Offset(-1, 0).value _
                                              & FirstTableCell.Offset(-1, 1).value)      'Concatenate value of both dropdown cells

        ActiveSheet.ListObjects(sCurrentTableName).Name = sNewTableName
    End If
End Sub


Function GetTableName(cell As Range) As String
    ' Returns the Table name associated with the incoming cell.
    ' Returns "" (empty string) if the cell is not part of a Table.
    If Not (cell.ListObject Is Nothing) Then
        GetTableName = cell.ListObject.Name
    End If
End Function


Private Sub Worksheet_Change(ByVal Target As Range)
    ' Check if the cell changing is one of the 2 "name" cells above a Table area.
    ' If it is, rename the Table below
    If Target.Cells.Count > 1 Then Exit Sub

    Dim cellTableName As String
    Dim matchingTable As ListObject

    If GetTableName(Target) = "" Then
        ' This cell is not inside a table.  Check the cell below.

        cellTableName = GetTableName(Target.Offset(1, 0))   'Table Name for the cell immediately below
        If cellTableName > "" Then
            ' The cell immediately below IS part of a Table.
            ' Check if this (changing) cell is over Column 1 or 2 of the Table.

            Set matchingTable = Target.Worksheet.ListObjects(cellTableName)
            With matchingTable

                If Target.Column = .DataBodyRange.Columns(1).Column _
                Or Target.Column = .DataBodyRange.Columns(2).Column Then

                     ChangeTableName (cellTableName)

                End If
            End With

        End If
    End If
End Sub