Results 1 to 9 of 9

Thread: Removing unused Cell styles - need an efficient code

  1. #1
    Junior Member
    Join Date
    Oct 2011
    Posts
    5
    Rep Power
    0

    Removing unused Cell styles - need an efficient code

    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

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi Sidd,

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

    Code:
    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
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  3. #3
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi Sidd,

    Here you go.


    Code:
    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.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  4. #4
    Junior Member
    Join Date
    Oct 2011
    Posts
    5
    Rep Power
    0
    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

  5. #5
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi Sidd,

    Thanks for the feedback.

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

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  6. #6
    Junior Member
    Join Date
    Oct 2011
    Posts
    5
    Rep Power
    0
    Hi,

    The error was encountered on the following line...

    With .Worksheets(i).UsedRange

    no the sheets were not protected..

    Cheers
    Sidd

  7. #7
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi,

    OK. Let me know ;

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

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  8. #8
    Junior Member
    Join Date
    Oct 2011
    Posts
    5
    Rep Power
    0
    Hi, no scroll area was set but yes, there are a few hidden columns and rows in the sheets.

    Thanks
    Sidd

  9. #9
    Junior Member
    Join Date
    Apr 2013
    Posts
    1
    Rep Power
    0
    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.

    Code:
    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
    Last edited by rondeondon; 04-16-2013 at 05:43 AM.

Similar Threads

  1. Replies: 2
    Last Post: 05-30-2013, 07:28 PM
  2. Remove Unused Custom Styles VBA
    By Admin in forum Excel and VBA Tips and Tricks
    Replies: 0
    Last Post: 08-23-2012, 02:32 PM
  3. Replies: 1
    Last Post: 08-21-2012, 07:36 PM
  4. VB code to Run formula untill blank cell
    By Rajesh Kr Joshi in forum Excel Help
    Replies: 8
    Last Post: 05-20-2012, 11:08 AM
  5. Replies: 8
    Last Post: 10-06-2011, 01:29 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •