Hi All,
To remove unused custom styles from a workbook.
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.
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=tzbKqTRuRzU&lc=UgyYW2WZ2DvSrzUKnJ14AaABAg
https://www.youtube.com/watch?v=UywjKEMjSp0&lc=UgxIySxHPqM1RxtVqoR4AaABAg. 9edGvmwOLq99eekDyfS0CD
https://www.youtube.com/watch?v=UywjKEMjSp0&lc=UgxIySxHPqM1RxtVqoR4AaABAg. 9edGvmwOLq99eevG7txd2c
https://www.youtube.com/watch?v=SIDLFRkUEIo&lc=UgzTF5vvB67Zbfs9qvx4AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgzytUUVRyw9U55-6M54AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgzCoa6tOVIBxRDDDbN4AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgyriWOelbVnw4FHWT54AaABAg. 9dPo-OdLmZ09dc21kigjmr
https://www.youtube.com/watch?v=363wd2EtQZ0&lc=UgzDQfo5rJqyVwvv2r54AaABAg
https://www.youtube.com/watch?v=363wd2EtQZ0&lc=UgzHTSka7YppBdmUooV4AaABAg. 9cXui6zzkz09cZttH_-2Gf
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
