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

 

[jgarret08]

RoryA, I was wondering how to mark this thread SOLVED? I tried looking for it in FAQs, and can't seem to find how. thanks again. cheers

 

[RoryA]

We don't do that here. All you have to do is say thanks.

 

[Gimics]

Hey RoryA! I came across this after several attempts at creating an efficient macro to remove workbook styles, over the last few years of working with Excel spreadsheets containing data extracts from SAP. The current macro I run can take upwards of 15 minutes in a workbook with the max ~64,000 styles.

It seems like editing the styles.xml file is by far the most efficient way to remove styles, however an automated approach like the macro in your reply would be fantastic for ease of allowing all of our Finance team to do this on their own.

Should this macro still work on newer version of excel? For me, the result of running the macro is just that a .zip file and the styles.xml file now exist in the folder containing the spreadsheet. Can you walk me through if that was the intent, or if there is something I'm missing?

Greatly appreciated.

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="" custombuiltin="" 1""=""></cellstyle></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.

</cellstyles"