Removing unused Cell styles - need an efficient code

[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