Removing unused Cell styles - need an efficient code

[siddharthsindhwani]

Dear All,

While working on various models, the users sometimes move sheets or copy formats from different workbooks leading to duplicate or junk cell styles.

Removing the same is a tedious task when the model grows in size, sheets etc.

The method of removing the same by making a an excel file .zip and editing the styles.xml is not only risky but confusing as well.

Can we have a code (efficient one, we have many which loop through sheets and ranges taking ages to complete) which finds the unused custom cell styles and deletes the same?

Thanks
Sidd

[Admin]

Hi Sidd,

try this one, although it loops all the styles. This code would delete all the non-built styles.

Sub RemoveStyles()

    Dim i   As Long
    Dim c   As Long
    
    
    With ThisWorkbook
        c = .Styles.Count
        For i = 1 To c
            If Not .Styles(i).BuiltIn Then
                .Styles(i).Locked = False
                .Styles(i).Delete
            End If
        Next
    End With
    
End Sub

[Admin]

Hi Sidd,

Here you go.

Sub RemoveUnusedStyles()
    
    '// Author  : Admin @ ExcelFox.com
    '// Purpose : Delete all unused styles from a workbook.
    
    Dim i   As Long
    Dim c   As Long
    Dim n   As Long
    Dim r   As Long
    Dim d   As Object
    Dim s   As Style
    Dim a
        
    Set d = CreateObject("scripting.dictionary")
        d.comparemode = 1
    
    With ThisWorkbook
        n = .Styles.Count
        'get all the non-built styles
        For i = 1 To n
            If Not .Styles(i).BuiltIn Then
                d.Item(.Styles(i).NameLocal) = False
            End If
        Next
        
        n = 0
        For i = 1 To .Worksheets.Count
            With .Worksheets(i).UsedRange
                For c = 1 To .Columns.Count
                    For r = 1 To .Rows.Count
                        Set s = .Cells(r, c).Style
                        If Not s.BuiltIn Then
                            'match cell style with the style collections
                            If d.exists(ThisWorkbook.Styles(s.Name).NameLocal) Then
                                d.Item(ThisWorkbook.Styles(s.Name).NameLocal) = True
                            End If
                        End If
                    Next
                Next
            End With
        Next
        a = Array(d.keys, d.items)
        For i = LBound(a) To UBound(a(0))
            'delete unused styles
            If Not CBool(a(1)(i)) Then
                .Styles(a(0)(i)).Locked = False
                .Styles(a(0)(i)).Delete
            End If
        Next
    End With
    
End Sub

Word of caution. Please create a backup of your file before trying this code.

Let us know the result.

[siddharthsindhwani]

Hi,

The code is much faster than its other predecessors as you have used the Arrays. Many thanks for this.

I believe there is no other way than to loop through each cell on each sheet to identify the used cell styles, as for models with large used ranges and many sheets. This will take a little bit longer.

Just one quick comment, we should have error trapping in the same, as I have encountered error 'Method 'UsedRange' of object '_Worksheet' failed'.

But again many thanks for this and in such a quick time...

Super and keep rocking guys

Cheers
Sidd

[Admin]

Hi Sidd,

Thanks for the feedback.

In which line you got the error ? Also is there any sheet which is protected ?

[siddharthsindhwani]

Hi,

The error was encountered on the following line...

With .Worksheets(i).UsedRange

no the sheets were not protected..

Cheers
Sidd

[Admin]

Hi,

OK. Let me know ;

1. Do the sheets have set scroll area ?
2. Any sheets in which unused columns and rows are hidden

[siddharthsindhwani]

Hi, no scroll area was set but yes, there are a few hidden columns and rows in the sheets.

Thanks
Sidd

[rondeondon]

Hi Admin

I have made a change to the order of operations in the macro as I tried to run it on a workbook with a sheet with 20,000 lines, it was still running 18 hours later. The problem was my workbook has acquired 12,000 styles and doing the comparison for every cell took a long time.

In my version I create a list of used styles and set the available styles to found then delete the rest. The macro ran in 5 minutes.

I changed the "ThisWorkbook" to "ActiveWorkbook" as I keep all of my macors in one file and run them from there.

Sub RemoveUnusedStyles()
    
    '// Author  : Admin @ ExcelFox.com
    '// Purpose : Delete all unused styles from a workbook.
'alternate way of removing unused styles
'search through the file listing the styles in use
'list styles in file
'cycle through available styles comparing to in-use list
'remove listed styles not in use


    Dim i   As Long
    Dim c   As Long
    Dim n   As Long
    Dim r   As Long
    Dim d   As Object
    Dim s   As Style
    Dim a
    Dim StyleCount As Long
    Dim StyleRemoval As Long
    Dim StartTime As Variant
    Dim Endtime As Variant
    Dim availableStyle(64000) As String
    Dim availableStylecount As Long
    Dim usedStyle(64000) As String
    Dim usedStyleCount As Long
    Dim foundStyle As Boolean
    
    StartTime = Now()
            
    Set d = CreateObject("scripting.dictionary")
        d.comparemode = 1
        
    availableStylecount = 0
    With ActiveWorkbook
        n = .Styles.Count
        'get all the non-built styles
        'add names of custom styles to array availableStyle
        For i = 1 To n
            If Not .Styles(i).BuiltIn Then
                d.Item(.Styles(i).NameLocal) = False
                availableStylecount = availableStylecount + 1
            End If
        Next
        
        StyleCount = n
        
        n = 0
        usedStyleCount = 0
        For i = 1 To .Worksheets.Count
            With .Worksheets(i).UsedRange
                For c = 1 To .Columns.Count
                    For r = 1 To .Rows.Count
                        Set s = .Cells(r, c).Style
                        If Not s.BuiltIn Then
                            'check if this style has been added to the array of usedStyleCount
                            'if not then add it
                            foundStyle = False
                            n = 0
                            While n <= usedStyleCount And foundStyle = False
                                If usedStyle(n) = s.Name Then
                                    foundStyle = True
                                End If
                                n = n + 1
                            Wend
                            If Not foundStyle Then
                                usedStyle(usedStyleCount) = s.Name
                                d.Item(ActiveWorkbook.Styles(s.Name).NameLocal) = True
                                usedStyleCount = usedStyleCount + 1
                            End If
                        End If 'not built in style
                    Next
                Next
            End With
        Next
        
                   
        'Cycle through list of styles, delete unused styles
        a = Array(d.keys, d.items)
        For i = LBound(a) To UBound(a(0))
            'delete unused styles
            If Not CBool(a(1)(i)) Then
                If Not .Styles(a(0)(i)).BuiltIn Then
                    .Styles(a(0)(i)).Locked = False
                    .Styles(a(0)(i)).Delete
                    StyleRemoval = StyleRemoval + 1
                End If
            End If
        Next


   End With
   
   Endtime = Now()
   
   
   MsgBox "This file initially contained: " & StyleCount & " Styles." & vbCr & _
         "The Macro removed: " & StyleRemoval & vbCr & _
         "The macro took: " & Format(Endtime - StartTime, "hh:nn:ss") & vbCr & _
         "Start: " & Format(StartTime, "dd/mm/yy hh:nn:ss") & "  End: " & Format(Endtime, "dd/mm/yy hh:nn:ss"), vbOKOnly, "Score Card"
         
End Sub

I used this macro in sheets that were a collation of many other sheets and acquired so many excess styles along the way that excel began advising me that it could not paste in data.

Thanks

Ron