Created
September 1, 2016 22:55
-
-
Save airstrike/23fb59138783c6d1c1cbc06485291062 to your computer and use it in GitHub Desktop.
VBA: Remove unused cell styles from Excel
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
' Latest version available at: | |
' http://stackoverflow.com/questions/2449755/too-many-different-cell-formats/8933399#8933399 | |
' Description: | |
' Borrowed largely from http://www.jkp-ads.com/Articles/styles06.asp | |
Option Explicit | |
' Description: | |
' This is the "driver" for the entire module. | |
Public Sub DropUnusedStyles() | |
Dim styleObj As Style | |
Dim rngCell As Range | |
Dim wb As Workbook | |
Dim wsh As Worksheet | |
Dim str As String | |
Dim iStyleCount As Long | |
Dim dict As New Scripting.Dictionary ' <- from Tools / References... / "Microsoft Scripting Runtime" | |
' wb := workbook of interest. Choose one of the following | |
' Set wb = ThisWorkbook ' choose this module's workbook | |
Set wb = ActiveWorkbook ' the active workbook in excel | |
Debug.Print "BEGINNING # of styles in workbook: " & wb.Styles.Count | |
MsgBox "BEGINNING # of styles in workbook: " & wb.Styles.Count | |
' dict := list of styles | |
For Each styleObj In wb.Styles | |
str = styleObj.NameLocal | |
iStyleCount = iStyleCount + 1 | |
Call dict.Add(str, 0) ' First time: adds keys | |
Next styleObj | |
Debug.Print " dictionary now has " & dict.Count & " entries." | |
' Status, dictionary has styles (key) which are known to workbook | |
' Traverse each visible worksheet and increment count each style occurrence | |
For Each wsh In wb.Worksheets | |
If wsh.Visible Then | |
For Each rngCell In wsh.UsedRange.Cells | |
str = rngCell.Style | |
dict.Item(str) = dict.Item(str) + 1 ' This time: counts occurrences | |
Next rngCell | |
End If | |
Next wsh | |
' Status, dictionary styles (key) has cell occurrence count (item) | |
' Try to delete unused styles | |
Dim aKey As Variant | |
On Error Resume Next ' wb.Styles(aKey).Delete may throw error | |
For Each aKey In dict.Keys | |
' display count & stylename | |
' e.g. "24 Normal" | |
Debug.Print dict.Item(aKey) & vbTab & aKey | |
If dict.Item(aKey) = 0 Then | |
' Occurrence count (Item) indicates this style is not used | |
Call wb.Styles(aKey).Delete | |
If Err.Number <> 0 Then | |
Debug.Print vbTab & "^-- failed to delete" | |
Err.Clear | |
End If | |
Call dict.Remove(aKey) | |
End If | |
Next aKey | |
Debug.Print "ENDING # of style in workbook: " & wb.Styles.Count | |
MsgBox "ENDING # of style in workbook: " & wb.Styles.Count | |
End Sub |
Fails at Dim dict As New Scripting.Dictionary
@andrewhoyle, you need to add a reference to the Scripting.Dictionary library. From https://excelmacromastery.com/vba-dictionary#Creating_a_Dictionary
To use the Dictionary you need to first add the reference.
- Select Tools->References from the Visual Basic menu.
- Find Microsoft Scripting Runtime in the list and place a check in the box beside it.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Fails at Dim dict As New Scripting.Dictionary