Macro to edit styles.xml file of workbook

[Gimics]

Hey pro-team!

Our company has a problem with copying and pasting data dumps from our ERP system into workbooks over-and-over, resulting in compounding workbook styles to the point where multiple workbooks each month hit the excel style count max (~64,000), which causes workbook crashing and an inability to use these worksheets until the styles are fixed.

I've done a decent amount of research to try to discover the best way to fix these files. I've tried these things:

1. Macro that loops through styles and deletes the unused styles - takes a long time in a workbook with 30+ tabs and 64,000 styles
2. Macro that loops through styles and deletes the non-built in styles - takes at least 15 minutes in any size workbook with 64,000 styles
3. Editing the styles.xml file manually to delete the styles - with 64,000 styles, it's nearly impossible to delete all styles but the built-in styles. If all of the styles are deleted, the entire workbook loses all of it's formatting.

I am hoping someone can help me with building a macro to open and edit the styles.xml file to remove all of the relevant style records associated with styles that are not the built in styles. I think I know enough to walk through this with the manual approach, but don't know enough vba to automate.

The first step would be to get at the styles.xml file for the excel spreadsheet. The manual method I've seen for doing this is to manually change the extension of the excel file from .xls? to .zip, and then the styles.xml file is saved in the /xl directory. Example: "\Book1.zip\xl\styles.xml"

I think the seconds step is to then create an array or several arrays with the relevant cell style sections in the xml file. Based on my research and testing, there are three relevant sections of the xml (this a valuable reference: https://wiki.openoffice.org/wiki/Cell_Style_in_Xls_module)

<cellstylexfs ...=""> has the master formatting records. It has zero-based "xf" records indexed and referenced later using "xfID="N"" tags.
<cellxfs ...=""> has the master formatting "xf" records that are first applied and reference the cellstylexfs indexed records using "xfID="N" tags.
<cellstyles ...=""> has the named style "cellStyle" records and reference the cellstylexfs index records using "xfID="N" tags. Built in Styles are also indexed and labelled with builtinId="30" tags.

I created a test workbook with 10 cell styles applied, five of which are built in and five of which are not built in. These are the relevant xml sections that I think need to be edited
(my apologies for the terrible formatting - I couldn't wrap the xml code in anything without it disappearing entirely):
<cellStyleXfs count="11">
<xf numFmtId="0" fontId="0" fillId="0" borderId="0" />
<xf numFmtId="0" fontId="2" fillId="2" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="3" fillId="3" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="4" fillId="4" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="1" fillId="5" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="1" fillId="6" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="6" fillId="7" borderId="1" />
<xf numFmtId="0" fontId="5" fillId="8" borderId="0" />
<xf numFmtId="0" fontId="7" fillId="9" borderId="1" />
<xf numFmtId="0" fontId="8" fillId="10" borderId="0" />
<xf numFmtId="0" fontId="9" fillId="11" borderId="0" />
</cellStyleXfs>

<cellXfs count="11">
<xf numFmtId="0" fontId="0" fillId="0" borderId="0" xfId="0" />
<xf numFmtId="0" fontId="3" fillId="3" borderId="0" xfId="2" />
<xf numFmtId="0" fontId="2" fillId="2" borderId="0" xfId="1" />
<xf numFmtId="0" fontId="4" fillId="4" borderId="0" xfId="3" />
<xf numFmtId="0" fontId="1" fillId="5" borderId="0" xfId="4" />
<xf numFmtId="0" fontId="1" fillId="6" borderId="0" xfId="5" />
<xf numFmtId="0" fontId="6" fillId="7" borderId="1" xfId="6" />
<xf numFmtId="0" fontId="5" fillId="8" borderId="0" xfId="7" />
<xf numFmtId="0" fontId="7" fillId="9" borderId="1" xfId="8" />
<xf numFmtId="0" fontId="8" fillId="10" borderId="0" xfId="9" />
<xf numFmtId="0" fontId="9" fillId="11" borderId="0" xfId="10" />
</cellXfs>

<cellStyles count="11">
<cellStyle name="20% - Accent1" xfId="4" builtinId="30" />
<cellStyle name="20% - Accent2" xfId="5" builtinId="34" />
<cellStyle name="Bad" xfId="2" builtinId="27" />
<cellStyle name="Good" xfId="1" builtinId="26" />
<cellStyle name="Neutral" xfId="3" builtinId="28" />
<cellStyle name="Normal" xfId="0" builtinId="0" />
<cellStyle name="Style 1" xfId="6" />
<cellStyle name="Style 2" xfId="7" />
<cellStyle name="Style 3" xfId="8" />
<cellStyle name="Style 4" xfId="9" />
<cellStyle name="Style 5" xfId="10" />
</cellStyles>


I think the macro would need to identify the indexes (xfID values) for all of the styles with "buildinId" tags, and then delete all of the records in all three sections for styles that are not built in. After the macro runs, I think these sections should look like this:
<cellStyleXfs count="11">
<xf numFmtId="0" fontId="0" fillId="0" borderId="0" />
<xf numFmtId="0" fontId="2" fillId="2" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="3" fillId="3" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="4" fillId="4" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="1" fillId="5" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
<xf numFmtId="0" fontId="1" fillId="6" borderId="0" applyNumberFormat="0" applyBorder="0" applyAlignment="0" applyProtection="0" />
</cellStyleXfs>

<cellXfs count="11">
<xf numFmtId="0" fontId="0" fillId="0" borderId="0" xfId="0" />
<xf numFmtId="0" fontId="3" fillId="3" borderId="0" xfId="2" />
<xf numFmtId="0" fontId="2" fillId="2" borderId="0" xfId="1" />
<xf numFmtId="0" fontId="4" fillId="4" borderId="0" xfId="3" />
<xf numFmtId="0" fontId="1" fillId="5" borderId="0" xfId="4" />
<xf numFmtId="0" fontId="1" fillId="6" borderId="0" xfId="5" />
</cellXfs>

<cellStyles count="11">
<cellStyle name="20% - Accent1" xfId="4" builtinId="30" />
<cellStyle name="20% - Accent2" xfId="5" builtinId="34" />
<cellStyle name="Bad" xfId="2" builtinId="27" />
<cellStyle name="Good" xfId="1" builtinId="26" />
<cellStyle name="Neutral" xfId="3" builtinId="28" />
<cellStyle name="Normal" xfId="0" builtinId="0" />
</cellStyles>


Might be a crazy big ask, but I really can't find anything else out there that get's this detailed on this problem (I've found a lot of posts with common problems, and a few posts with partial or manual solutions).

Thanks in advance!</cellstyles></cellxfs></cellstylexfs>

 

[ZVI]

Hi,

There is a free & ready to use XLStylesTool application for that in Windows App Store.
A link to the previous EXE WinForms version of that great tool can be found on the author’s XLGeek web page.

Regards

 

[Gimics]

Thanks ZVI - sounds like my macro ask is right in line with how that utility works. However, our organization is relatively locked down for software downloads, so downloading and distributing the tool might not be an option.

Any takers on the macro?

I found this post from 2016 where RoryA created a macro that is very close to what needs to be done. His macro appears to delete all styles though, and it rarely worked for me as the VBA was having challenges accessing the styles.xml file in the .zip folder it creates (I know this because the only way I could get it to work was if I navigated into the .zip file while stepping through the macro). The few times it did work, my excel spreadsheet either had all styles removed from all cells, or the file didn't change.

Here's RoryA's code for reference:

Const csSTYLES_START As String = ""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

 

[ZVI]

Because of a forum limitation (not sure from what date) the constants in RoryA's code became not valid.
Try this restoration:

Const csSTYLES_START As String = "<" & "cellstyles"
Const csSTYLES_CLOSE As String = "<" & "/cellstyles" & ">"
Const csDEFAULT_STYLES As String = csSTYLES_START & " count=""1""" & ">" _
    & "<" & "cellStyle name=""Normal"" xfId=""0"" builtinId=""0"" customBuiltin=""1"" /" & ">" _
    & csSTYLES_CLOSE
 
Sub ListZipDetails()
  '... Code of the sub is here ...
End Sub

The code cleans all custome styles, but formats of cells stays formatted properly.
Then open a fixed workbook in Excel and save it.

 

[ZVI]

Actually csDEFAULT_STYLES can be an empty string, because Excel will rebuild it with a correct localization name after workbook saving.

 

[ZVI]

... However, our organization is relatively locked down for software downloads, so downloading and distributing the tool might not be an option...

Application installed from Windows App Store (see the link in my post #2 ) is safety.
Send this explanation to your IT department and ask to install XLStylesTool on your PC.

 

[Gimics]

Thanks Vladimir - the macro seems to be getting further along than it was before, however I'm hanging up on this line:

avarData = Left$(avarData, lStart - 1) & csDEFAULT_STYLES & Mid$(avarData, lStop + Len(csSTYLES_CLOSE))

I get an "Invalid procedure call or argument" error - it happens regardless of I have csDEFAULT_STYLES as the full string you provided or blank.

 

[Gimics]

Is it possible the avarData variable is running into a length limit? <cellstyles" string.
The character length of the styles.xml file is 12,472,440... which is hilarious, but I guess indicative of the problem.

It looks like the lStart and lStop variables are both remaining as "0", which I would assume means that the <cellstyles and="" <="" cellstyles=""> text isn't being found in avarData.</cellstyles></cellstyles">

 

[ZVI]

Looks like your code is not complete/correct.
The Debugging is required.
Use Option Explicit as the top line of the code module and check the code by VBE - Debug - Compile.
Here is my testing code for avarData which works properly:

Option Explicit
 
Const csSTYLES_START As String = "<" & "cellstyles"
Const csSTYLES_CLOSE As String = "<" & "/cellstyles" & ">"
Const csDEFAULT_STYLES As String = csSTYLES_START & " count=""1""" & ">" _
    & "<" & "cellStyle name=""Normal"" xfId=""0"" builtinId=""0"" customBuiltin=""1"" /" & ">" _
    & csSTYLES_CLOSE
 
Sub Test()
 
  Dim lStart&, lStop&, avarData$
 
  avarData = "Dummy123" _
           & csSTYLES_START & " count='3'" _
           & "(cellStyle name='Normal' xfId='0' builtinId='0' /)" _
           & "(cellStyle name='Style 1' xfId='1' /)" _
           & "(cellStyle name='Style 2' xfId='2' /)" _
           & csSTYLES_CLOSE _
           & "Dummy456"
  avarData = Replace(avarData, "(", vbLf & "<")
  avarData = Replace(avarData, ")", "<")
 
  lStart = InStr(1, avarData, csSTYLES_START, vbBinaryCompare)
  lStop = InStr(1, avarData, csSTYLES_CLOSE, vbBinaryCompare)
  Debug.Print "lStart = " & lStart, "lStop = " & lStop
 
  avarData = Left$(avarData, lStart - 1) & csDEFAULT_STYLES & Mid$(avarData, lStop + Len(csSTYLES_CLOSE))
  Debug.Print avarData
  Debug.Print Replace(avarData, csDEFAULT_STYLES, "")
 
End Sub

If lStart and lStop variables are both equal to "0" than start and end tags of custom styles are not found and XML is not valid

 

[ZVI]

Is it possible the avarData variable is running into a length limit? <cellstyles" string.
The character length of the styles.xml file is 12,472,440... which is hilarious, but I guess indicative of the problem</cellstyles">

No, the lengthy avarData is not an issue:

Sub Test1()
  Dim i As Long, s As String
  s = String(12472440, "0") & "1"
  i = InStr(s, "1")
  Debug.Print Len(s), i
End Sub

Try using vbTextCompare instead of vbBinaryCompare just for the case