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