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