Here is another 1940 Ford Mercury. I cannot get enough of these cars – simply awesome! I think it is some of the details shown here that were incorporated into the Chrysler 300 that lead to the immense popularity of the Chrysler 300. Hopefully car manufacturers will take note and follow suit with stronger attention to design details.
In my last post, I showed you how to work with Excel Table TableStyles and how to customize them. However, followers of this blog (both of you) know that I’m a VBA guy. Let’s take a look how we might use VBA to work with Excel Table TableStyles.
TableStyles Property
The Workbook Object has a TableStyles Collection so we can work with TableStyles in a Workbook.
Option Explicit
Sub ListTableStyles()
Dim wb As Workbook
Dim ts As TableStyle
Dim i As Long
Set wb = ThisWorkbook
i = 1
With wb
For Each ts In .TableStyles
Debug.Print ts.Name
i = i + 1
Next ts
End With
Debug.Print "Number of TableStyles = ", i
Set wb = Nothing
End Sub
Results (truncated for brevity):
- TableStyleMedium2
- PivotStyleLight1
- SlicerStyleLight1
- TimeSlicerStyleLight1
- tsDataProse3
- Number of TableStyles = 174
That’s interesting. PivotStyles, SlicerStyles and TimeSlicerStyles are part of the TableStlyes Collection as well as TableStyles. That means as soon as we learn how to work with TableStyles, we can apply that knowledge PivotStyles, SlicerStyles and TimeSlicerStyles as well! 4 for the price of 1 – no charge!
However, for today, I’m only interested in Table Styles, so I’ll use the ShowAsAvailableTableStyle Property of the TableStyle Object to limit the Styles returned to only those related to Excel Tables:
Option Explicit
Sub ListTableStyles()
Dim wb As Workbook
Dim ts As TableStyle
Dim i As Long
Set wb = ThisWorkbook
i = 1
With wb
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
Debug.Print ts.Name
i = i + 1
End If
Next ts
End With
Debug.Print "Number of TableStyles = ", i
Set wb = Nothing
End Sub
Results (truncated for brevity):
- TableStyleLight1
- TableStyleMedium1
- TableStyleDark1
- tsDataProse
- Number of TableStyles = 64
Delete Then Add
In my last post on TableStyles, I duplicated an existing TableStyle and saved the duplicate TableStyle with a new name. When adding a TableStyle with VBA, we have to be careful when adding an item to any collection. If the item already exists, we will receive an error message.
First, I’ll just try to add a TableStyle without deleting it beforehand:
Option Explicit
Sub TestAddTableStyle()
Dim wb As Workbook
Dim ts As TableStyle
Set wb = ThisWorkbook
With wb
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
If ts.Name Like "*Medium*" Then
ts.Duplicate ("tsCustom" & ts.Name)
End If
End If
Next ts
End With
Set wb = Nothing
End Sub
As you see, since the TableStyle already exists, I receive the “Application-defined error message” and the error message is not very helpful at that. I like to handle adding Objects to Collections by trying to delete them first
I’ll delete the TableStyles I added in my last post. I named each of those Styles “ts…” so I can use use so safely loop through all TableStyles and delete any that begin with ts:
Option Explicit
Sub DeleteTableStyles()
Dim wb As Workbook
Dim ts As TableStyle
Set wb = ThisWorkbook
With wb
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
If Left(ts.Name, 2) = "ts" Then
ts.Delete
End If
End If
Next ts
End With
Set wb = Nothing
End Sub
Now when I check all TableStyles, I only have 61 whereas before I had 64. Now, I can modify the code to duplicate an existing style and save it with a new name safely as I have the code to delete the Style first.
Recall from my first post on TableStyles, I prefer the “Medium” Styles as opposed to the Light or Dark Styles. So I will only concern myself with making copies of the Medium Styles:
Option Explicit
Sub TestElements()
Dim wb As Workbook
Dim ts As TableStyle
Set wb = ThisWorkbook
With wb
For Each ts In .TableStyles
If Left(ts.Name, 2) = "ts" Then
ts.Delete
End If
Next ts
For Each ts In .TableStyles
If ts.Name Like "*Medium*" Then
ts.Duplicate ("tsCustom" & ts.Name)
End If
Next ts
End With
Set wb = Nothing
End Sub
Now when I list out the TableStyles I find that I added 29 Custom Table Styles, far more than I really need:
Option Explicit
Sub ListTableStyles()
Dim wb As Workbook
Dim ts As TableStyle
Dim i As Long
Set wb = ThisWorkbook
i = 1
With wb
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
If ts.Name Like "*Custom*" Then
Debug.Print ts.Name
i = i + 1
End If
End If
Next ts
End With
Debug.Print "Number of TableStyles = ", i
Set wb = Nothing
End Sub
I’ll try to modify the code a bit o just add the Custom Styles I like. I like Medium TableStyles 2-7, so I should only add 6 Custom TableStyles.
Option Explicit
Sub AddCustomTableStyles()
Dim wb As Workbook
Dim ts As TableStyle
Set wb = ThisWorkbook
With wb
'If custom table style already exists - delete it
For Each ts In .TableStyles
If Left(ts.Name, 2) = "ts" Then
ts.Delete
End If
Next ts
'Add custom table styles
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
If ts.Name Like "*Medium*" Then
If CLng(Right(ts.Name, 1)) >= 2 And _
CLng(Right(ts.Name, 1)) <= 7 Then
ts.Duplicate ("tsCustom" & ts.Name)
End If
End If
End If
Next ts
End With
Set wb = Nothing
End Sub
Getting closer, that only added 18 Custom TableStyles. One more try:
Option Explicit
Sub AddCustomTableStyles()
Dim wb As Workbook
Dim ts As TableStyle
Set wb = ThisWorkbook
With wb
'If custom table style already exists - delete it
For Each ts In .TableStyles
If Left(ts.Name, 2) = "ts" Then
ts.Delete
End If
Next ts
'Add custom table styles
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
If ts.Name Like "*Medium*" Then
If Not IsNumeric(Right(ts.Name, 2)) Then
If CLng(Right(ts.Name, 1)) >= 2 And _
CLng(Right(ts.Name, 1)) <= 7 Then
ts.Duplicate ("tsCustom" & ts.Name)
End If
End If
End If
End If
Next ts
End With
Set wb = Nothing
End Sub
Results:
- tsCustomTableStyleMedium2
- tsCustomTableStyleMedium3
- tsCustomTableStyleMedium4
- tsCustomTableStyleMedium5
- tsCustomTableStyleMedium6
- tsCustomTableStyleMedium7
- Number of TableStyles = 6
http://dataprose.org/wp-admin/admin.php?page=wp101
Great! That’s what I was looking for. Now I need to modify the assorted elements of the Custom Table Styles as I did manually in my previous post.
Table Style Elements
There are 45 different Elements in the xlTableStyleElements Enumeration. Check them out here
Recall from my post on manually customizing TableStyles, I duplicated an existing Style and only modified:
- the Inside Vertical Border of the Header Row
- the Inside Vertical Border of the First Row Stripe
Option Explicit
Sub CustomizeTableStyleElements()
Dim wb As Workbook
Dim ts As TableStyle
Dim lngGrey As Long
Set wb = ThisWorkbook
lngGrey = RGB(217, 217, 217)
With wb
For Each ts In .TableStyles
If ts.Name Like "*Custom*" Then
'Customize header row
With ts.TableStyleElements(xlHeaderRow).Borders(xlInsideVertical)
.Color = vbWhite
.Weight = xlThin
End With
'Customize data body range
With ts.TableStyleElements(xlRowStripe1).Borders(xlInsideVertical)
.Color = lngGrey
.Weight = xlThin
End With
End If
Next ts
End With
Set wb = Nothing
End Sub
I used the enumeration of the Table Style Elements to locate the names of the elements I wanted to customize and then set the properties according to my preferences.
I’ll check the results back in the Excel Workbook:
We can also loop through the Excel Tables in the Workbook to apply the new Custom Style:
Option Explicit
Sub ApplyCustomStyle()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim ts As TableStyle
Dim strTableStyle As String
Set wb = ThisWorkbook
'Assign a workbook default to the string variable
With wb
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
If ts.Name Like "*Medium*" Then
strTableStyle = ts.Name
Exit For
End If
End If
Next ts
End With
'If a cutom style exists, overwrite the value of the string variable
With wb
For Each ts In .TableStyles
If ts.ShowAsAvailableTableStyle Then
If ts.Name Like "tsCustom*" Then
strTableStyle = ts.Name
Exit For
End If
End If
Next ts
End With
'Assign the TableStyle to each Table in the Workbook
With wb
For Each ws In .Worksheets
For Each lo In ws.ListObjects
lo.TableStyle = strTableStyle
Next lo
Next ws
End With
Set wb = Nothing
End Sub
Tidy up
That’s it for today. Hopefully you found something here about using the LIKE Operator, the CLNG Function, the RGB Function and the Exit Statement as well as working with TableStyles and TableStyleElements.
Other Excel Table Articles At dataprose.org
- Sur La [Excel] Table
- Listing Toward ListObjects [Excel Tables]
- Come Together [Excel Workbooks]
- H2H – Excel Range Object Versus ListObject Object
- Customize Your Excel Tables