1940MercuryFinal

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:

ObjectExplorerShowAsAvailableTableStyleFin

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

TableStyleError

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:

CustomTableStylesGroup


CustomTableStylesElementHeaderRowFinal


CustomTableStylesElementFirstRowStripeFinal


CustomTableStylesVBAAppliedFinal

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

Other Excel Table Articles Around The Horn

, , , , , , , , , , ,