Cannot delete Excel Styles

[jgarret08]

Hi everyone,

I have this Excel file I'm working on that's been passed on for years. Now, it has more than 5000+ cell styles. The cell styles are very messy and most of them have special characters. I wanted to remove them and I used an Excel add-in from the Office support site (RemoveStyles.xlam) to do this. It was able to remove most of it but there were 300+ left. Now when I try to manually delete them, it says "style xxx not found". Please help, I can send a sample file if needed.

I've been searching in forums for days but cannot find any fix. Thanks in advance!

Cheers

 

[tygrrboi]

does this not work for you?

[COLOR=#000000][FONT=Verdana]Sub ClrStyles()[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Dim mpStyle As Style
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]For Each mpStyle In ActiveWorkbook.Styles[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    If Not mpStyle.BuiltIn Then [/FONT][/COLOR][COLOR=#000000][FONT=Verdana]mpStyle.Delete[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Next mpStyle
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]End Sub

[/FONT][/COLOR]

 

[jgarret08]

Thanks for the prompt response. No, it doesn't. It says run time error 1004 (application-defined or object defined). I assume this is because some styles do not exist anymore but it just shows up under Custom Cell Styles drop down. Hence, it is painful to remove them.

Below is a link to a sample spreadsheet.
https://drive.google.com/open?id=0B824ALrwmZy2NUNNanRVNWpEclU

does this not work for you?

[COLOR=#000000][FONT=Verdana]Sub ClrStyles()[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Dim mpStyle As Style
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]For Each mpStyle In ActiveWorkbook.Styles[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    If Not mpStyle.BuiltIn Then [/FONT][/COLOR][COLOR=#000000][FONT=Verdana]mpStyle.Delete[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Next mpStyle
[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]End Sub

[/FONT][/COLOR]

 

[jgarret08]

Please see screenshot below too.

Thanks for the prompt response. No, it doesn't. It says run time error 1004 (application-defined or object defined). I assume this is because some styles do not exist anymore but it just shows up under Custom Cell Styles drop down. Hence, it is painful to remove them.

Below is a link to a sample spreadsheet.
https://drive.google.com/open?id=0B824ALrwmZy2NUNNanRVNWpEclU

 

[wideboydixon]

Ewww. Lots of Asian characters in there. My suggestion is create a new workbook and copy over the sheets and code

WBD

 

[jgarret08]

The real file has 20 worksheets w/ 10,000+ rows each. So creating a new workbook and re-formatting one by one would be very painful versus just ignoring the annoying Asian character-cell styles. I hope someone can find a fix on how to get rid of them

Ewww. Lots of Asian characters in there. My suggestion is create a new workbook and copy over the sheets and code

WBD

 

[RoryA]

This is the simplest solution I've ever found: http://www.mrexcel.com/forum/excel-questions/3994-style-problem-unable-delete.html#post2687875

 

[wideboydixon]

That's genius! Just tried it on the workbook and it worked a treat (even though I use 7-Zip!).

WBD

 

[RoryA]

It's a bit rough and ready but something like this should work to automate it:

Const csSTYLES_START As String = "<cellStyles"
Const csSTYLES_CLOSE As String = "/cellStyles>"
Const csDEFAULT_STYLES As String = "<cellStyles count=""1""><cellStyle name=""Normal"" xfId=""0"" builtinId=""0"" customBuiltin=""1"" /></cellStyles>"
Sub ListZipDetails()
  Dim R As Long, PathFilename As Variant, FileNameInZip As Variant, oApp As Object, ZipFileName As Variant
  Dim lFile As Long
  Dim sStylePath As String
Dim varFileName, avarData
Dim fso As Object, tsrStream1 As Object
Dim lStart As Long, lStop As Long
  
  sStylePath = ThisWorkbook.Path & "\styles.xml"
  If Dir(sStylePath) <> vbNullString Then Kill sStylePath
  
  PathFilename = Application.GetOpenFilename("Excel XML files (*.xls?), *.xls?")
  If PathFilename = "False" Then Exit Sub
  
  ZipFileName = Left$(PathFilename, InStrRev(PathFilename, ".")) & "zip"
  If Dir(ZipFileName) <> vbNullString Then Kill ZipFileName
  
  FileCopy PathFilename, ZipFileName
  
  Set oApp = CreateObject("Shell.Application")
  oApp.Namespace(ThisWorkbook.Path & "\").copyhere oApp.Namespace(ZipFileName & "\xl").items.Item("styles.xml")
    Do Until Dir(sStylePath) <> vbNullString
        DoEvents
    Loop
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tsrStream1 = fso.OpenTextFile(sStylePath, 1, False)
    avarData = tsrStream1.ReadAll
    tsrStream1.Close
    lStart = InStr(1, avarData, csSTYLES_START, vbBinaryCompare)
    lStop = InStr(1, avarData, csSTYLES_CLOSE, vbBinaryCompare)
    avarData = Left$(avarData, lStart - 1) & csDEFAULT_STYLES & Mid$(avarData, lStop + Len(csSTYLES_CLOSE))
    Set tsrStream1 = fso.CreateTextFile(sStylePath, True)
    tsrStream1.Write avarData
    tsrStream1.Close
    oApp.Namespace(ZipFileName & "\xl").copyhere oApp.Namespace(ThisWorkbook.Path).items.Item("styles.xml")
  Set oApp = Nothing
  ' replace original file
  Kill PathFilename
  Name ZipFileName As PathFilename

End Sub

Make sure the workbook with the styles in is closed when you run this and answer yes to the prompt to replace the file in the zip folder.

 

[jgarret08]

You are very very very very awesome Mr. RoryA. Thanks a bunch. Worked like a charm.

This is the simplest solution I've ever found: http://www.mrexcel.com/forum/excel-questions/3994-style-problem-unable-delete.html#post2687875