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.9edGvmwOLq99eekDyfS0 CD
https://www.youtube.com/watch?v=UywjKEMjSp0&lc=UgxIySxHPqM1RxtVqoR4AaABAg.9edGvmwOLq99eevG7txd 2c
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




Reply With Quote

Bookmarks