Retrieve Names of Smart Tables And Corresponding Worksheets

Andreas Hermle
Andreas Hermle used Ask the Experts™
on
Dear Experts:

My current workbook is a multi-worksheet workbook.

All of these worksheets (with the exception of a worksheet named 'Overview) contain smart tables which I have named such aus 'MT_Surgery' or ' CT_Scissors' etc.

I now would like to retrieve all the names of these smart tables along with their location, i.e. which worksheet these named smart tables reside in.

This data is to be compiled in the worksheet named Overview.

So the result should look like this in the worksheet called 'Overview'

Example


Retrieve_Names_Smart_Tables_And_Corresponding_Worksheets
I guess this can only be achieved using a macro.

Help is very much appreciated. Thank you very much in advance.

Regards, Andreas
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
How is your question different from your last question?
Andreas HermleTeam leader

Author

Commented:
It differs as follows:

My last question was based on the assumption that all the named smart tables have been filled in manually in Column B of the 'Overview' Worksheet.

The new question asks the experts to also retrieve the user-defined names of the smart tables.

Thank you .
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
Okay. Please give this a try and let me know if this is what you are trying to achieve.

Sub ListTableNames()
Dim dws As Worksheet, ws As Worksheet
Dim tbl As ListObject
Dim lr As Long

Application.ScreenUpdating = True
Set dws = Worksheets("Overview")
dws.Columns("A:B").Clear
With dws.Range("A1:B1")
    .Value = Array("Name of Worksheet", "Name_Smart_Table")
    .Font.Bold = True
    .Font.Size = 13
End With
For Each ws In ThisWorkbook.Worksheets
    For Each tbl In ws.ListObjects
        If tbl.Name Like "??_*" Then
            lr = dws.Cells(Rows.Count, 1).End(xlUp).Row + 1
            dws.Range("A" & lr).Value = ws.Name
            dws.Range("B" & lr).Value = tbl.Name
        End If
    Next tbl
Next ws
dws.Columns("A:B").AutoFit
dws.Range("A1").CurrentRegion.Borders.Color = vbBlack
Application.ScreenUpdating = True
End Sub

Open in new window

Andreas HermleTeam leader

Author

Commented:
Great coding Subodh, I really appreciate your expertise :-) Thank you very much.

That is exactly how I wanted it.
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome Andreas!
Thanks for the feedback. :)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial