Change multple table names
OK I am assuming that the Table Header "Date" is the identifier for the table
that will be worksheet name & SFR and the other table will be worksheet name
& CT. Hope this is correct but if not then let me know.
NOTE: Ensure that you backup your workbook before testing the code.
The first sub will change the table names and the second is testing code
only and will iterate through the worksheets and tables on each sheet so that
you can check if they are correct. (You probably know this but just in case.
Ctrl/Break will stop the second code if you don't want to go through them
all.)
Sub ChangeTableName()
Dim ws As Worksheet
Dim LstObj As ListObject
Dim rngFind As Range
For Each ws In Worksheets
For Each LstObj In ws.ListObjects
With LstObj.HeaderRowRange
'Find the word Date in header row
Set rngFind = .Find(What:="Date", _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngFind Is Nothing Then
'Date found: Table Sheet name & SFR
LstObj.Name = ws.Name & "SFR"
Else
'Date NOT found: Table Sheet name & CT
LstObj.Name = ws.Name & "CT"
End If
End With
Next LstObj
Next ws
End Sub
'Testing code only
Sub TableDetails()
Dim ws As Worksheet
Dim LstObj As ListObject
For Each ws In Worksheets
For Each LstObj In ws.ListObjects
'Application.Goto LstObj.Range
MsgBox "Worksheet: " & ws.Name & vbCrLf & _
"Table name: " & _
LstObj.Name & vbCrLf & _
"Table range: " & LstObj.Range.Address & vbCrLf & _
"Headers: " & LstObj.HeaderRowRange.Address
Next
Next ws
End Sub
--
Regards,
OssieMac
|