Alternative approach to fix those problematic excel files when excel sees 1048576 as the last row # & you can't fix it.

[johnnyL]

I have created this thread to take a different approach than in my previous thread.

I was inspired by a post by @Dan_W in that thread that suggested to look at the xml code in the excel file.

This thread has the same goal to attempt to alter those problematic excel files that you have tried to erase the extra blank rows below the range of data in a sheet that seemingly can't be deleted. IE. after you attempt to delete those rows and then save the file, reopen the file, those extra 'blank' rows are still there & you remain with a seemingly way too big file.


I have seen some steps suggested on the internet to manually change the extension of an excel file to a zip entension, unzip that file, perform some alterations to an internal file in the zip file, rezip the files, rename the zip file back to the original file extension. I have NOT seen a script that performs all of those steps via a script for you.

I decided to create a script that will perform all of those manual steps I found, as well as a few others that will actually achieve the objective of correcting those problematic excel files that seem to have the lastcell row 'locked' to the maximum row # allowed in excel in a sheet.

When I say 'locked' I am referring to excel file sheets that you have tried to erase the extra blank rows below the range of data in a sheet that seemingly can't be deleted. IE. after you attempt to delete them and then save the file, reopen the file, those extra 'blank' rows are still there & you remain with a seemingly way too big file.

This script will ask you for the excel file that has the problematic sheet of 'ghost' blank rows that seeming can't be deleted. It will then ask you for a row # that should be the row # to start deleting all the way to the end of the file, which in these cases will be row # 1048576.

The script will then run and produce a new excel file that has '_shortened' added to the original excel file name. In other words, the script will not alter the original excel file that is selected by the user at the beginning of the script.

When the script is completed, you should see a newly created excel file that is noticeably smaller in file size than the original problematic file. Open up the new excel file that was created, in excel and see if those problematic 'blank' rows are gone.

Sub ZipAndUnzipExcelFileV_DeleteRows()
'
    Dim DialogBox                       As FileDialog
    Dim StartingRowToDelete             As Long
    Dim SourceFullName                  As String
'
    Set DialogBox = Application.FileDialog(msoFileDialogFilePicker)                 ' Create DialogBox to ask for file to use
    DialogBox.AllowMultiSelect = False                                              ' Allow only one file to be selected
    DialogBox.Title = "                                                                   "
    DialogBox.Title = DialogBox.Title & _
            "Select (.xlsx, .xlsm, .xlam) file to remove excess rows from"          ' Establish DialogBox.Title
'
    If DialogBox.Show <> -1 Then                                                    ' If no file selected then ...
        Exit Sub                                                                    '   Exit the sub
    Else                                                                            ' Else
        SourceFullName = DialogBox.SelectedItems(1)                                 '   Save the Path with file name & extension to SourceFullName
    End If                                                                          '
'
    StartingRowToDelete = Application.InputBox("Select the start row # to " & _
            "start deleting from", "Row #", Type:=1)                                ' Ask user what row to start deleting rows from
'
    Dim startTime                               As Single
    startTime = Timer                                                               ' Start the stopwatch
'
    Dim XML_EndRowDeleteCode                    As Double, XML_StartRowDeleteCode       As Double
    Dim XML_File                                As Long
    Dim FSO                                     As Object, ZipFile_Builder_Extracter    As Object
    Dim AdditionToFileName                      As String
    Dim SourceFileExtension                     As String, SourceFileName               As String, SourceFilePath   As String
    Dim XML_ReplacementSheetDataString          As String, XML_RowDeleteString          As String
    Dim XML_FileContents                        As String, XML_SheetFile                As String
    Dim TemporaryZipFullFilePathNameExtension   As Variant, TemporaryZipFilePath        As Variant
'
    With CreateObject("Scripting.FileSystemObject")                                 '
        SourceFilePath = .GetParentFolderName(SourceFullName) & "\"                 '   Get the path of the file selected
        SourceFileName = .GetBaseName(SourceFullName)                               '   Get the file name of the file selected
        SourceFileExtension = .GetExtensionName(SourceFullName)                     '   Get the extension of the file selected
    End With                                                                        '
'
    AdditionToFileName = "Temp" & Format(Now, " dd-mmm-yy h-mm-ss")                 ' Use date/time to create unique file name to add to selected file name
    TemporaryZipFullFilePathNameExtension = SourceFilePath & _
            AdditionToFileName & ".zip"                                             ' Save unique file name to TemporaryZipFullFilePathNameExtension
'
    On Error Resume Next                                                            ' Ignore errors and continue
    FileCopy SourceFullName, TemporaryZipFullFilePathNameExtension                  ' Copy and rename original file to a zip file with a unique name
'
    If Err.Number <> 0 Then                                                         ' If error detected then ...
        MsgBox "Unable to copy " & SourceFullName & vbNewLine _
        & "Verify the selected file is closed and try again"                        '   Alert the user
        Exit Sub                                                                    '   Exit the sub
    End If                                                                          '
    On Error GoTo 0                                                                 ' Enable Excel error handling
'
    TemporaryZipFilePath = SourceFilePath & AdditionToFileName & "\"                ' Save folder path for TemporaryZipFilePath
    MkDir TemporaryZipFilePath                                                      ' Create the temporary folder to unzip to
'
    Set ZipFile_Builder_Extracter = CreateObject("Shell.Application")               ' Create ZipFile_Builder_Extracter
    ZipFile_Builder_Extracter.Namespace(TemporaryZipFilePath).CopyHere _
            ZipFile_Builder_Extracter.Namespace(TemporaryZipFullFilePathNameExtension).items    ' Extract the files into the temporary folder
'
'-----------------------------------------------------------------------------------
'
'   loop through each file in the \xl\worksheets folder of the unzipped file
'
'       How will the problematic sheet be determined that needs the 'last row' corrected? ... Would have to enter the Codename to check for in each file ???
'
    XML_SheetFile = Dir(TemporaryZipFilePath & "\xl\worksheets\*.xml*")             ' Save xml file name into XML_SheetFile
'
    Do While XML_SheetFile <> ""                                                    ' Loop while an xml file is found
'       Read text of the xl\worksheets file to a variable
        XML_File = FreeFile                                                         '
        Open TemporaryZipFilePath & "xl\worksheets\" & _
                XML_SheetFile For Input As XML_File                                 '   Open the found xml file
        XML_FileContents = Input(LOF(XML_File), XML_File)                           '   Save the contents of the file into XML_FileContents
        Close XML_File                                                              '   Close the XML_File
'
'-----------------------------------------------------------------------------------
'
'       Do your code here ...
        XML_StartRowDeleteCode = 0
        XML_StartRowDeleteCode = InStr(1, XML_FileContents, "</row><row r=" & """" & _
                StartingRowToDelete & """")                                         '   Look through XML_FileContents for "</row><row r=" &
'                                                                                   '           """" & StartingRowToDelete & """" ... 3280
        If XML_StartRowDeleteCode > 0 Then
            XML_EndRowDeleteCode = InStr(XML_StartRowDeleteCode, _
                    XML_FileContents, "</sheetData>")                               '   Look through XML_FileContents for "</sheetData>" ... 41883802
'
            XML_RowDeleteString = Mid(XML_FileContents, XML_StartRowDeleteCode, _
                    XML_EndRowDeleteCode - XML_StartRowDeleteCode)                  '   Load the entire range of XML rows to delete into XML_RowDeleteString
'
            XML_FileContents = Replace(XML_FileContents, XML_RowDeleteString, "")   '   Erase the string that pertains to the 'Blank' rows range
'
            XML_FileContents = Replace(XML_FileContents, "</sheetData>", _
                    "</row></sheetData>")                                           '   Correct the end of the last row line remaining in the file
'
            XML_FileContents = Replace(XML_FileContents, " zeroHeight=" & _
                    """" & "1" & """", "")                                          '   Delete the hidden rows flag
        End If
'
'-----------------------------------------------------------------------------------
'
'       Output final changes to the file
        XML_File = FreeFile                                                         '
        Open TemporaryZipFilePath & "xl\worksheets\" & _
                XML_SheetFile For Output As XML_File                                '
        Print #XML_File, XML_FileContents                                           '   save data back to xml file
        Close XML_File                                                              '   Close the xml file
'
        XML_SheetFile = Dir                                                         '   Look for additional Excel file names
    Loop                                                                            ' Loop back check for next XML_File in directory
'
'   *********************************************
'
'   Create empty Zip File
    If Len(Dir(SourceFilePath & AdditionToFileName & ".zip")) > 0 Then Kill _
            SourceFilePath & AdditionToFileName & ".zip"                            ' If zip file already exists then delete it
    Open SourceFilePath & AdditionToFileName & ".zip" For Output As #1              '
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)               ' Write signature for an empty Zip file ...
'                                                                                   '       "PK|-                  "   18 spaces(null) at the end
    Close #1                                                                        '
'
'
'   Copy files into the zip file
    ZipFile_Builder_Extracter.Namespace(SourceFilePath & AdditionToFileName & _
            ".zip").CopyHere _
            ZipFile_Builder_Extracter.Namespace(TemporaryZipFilePath).items         ' Copy items to zip file
'
    On Error Resume Next                                                            ' Ignore errors and continue
    Do Until ZipFile_Builder_Extracter.Namespace(SourceFilePath & _
        AdditionToFileName & ".zip").items.Count = _
        ZipFile_Builder_Extracter.Namespace(TemporaryZipFilePath).items.Count       ' Loop until all items have been copied to the zip file
        Application.Wait (Now + TimeValue("0:00:01"))                               '   Wait 1 second to allow more compressing of the files being added
    Loop                                                                            ' Loop back
    On Error GoTo 0                                                                 ' Enable Excel error handling
'
'   Delete the temporary files & folders created earlier
    Set FSO = CreateObject("scripting.filesystemobject")                            ' Create filesystemobject
    FSO.deletefolder SourceFilePath & AdditionToFileName                            ' Delete all temporary files & folders that were created
'
'   Rename the newly created file to the original file extention
    Name SourceFilePath & AdditionToFileName & ".zip" As SourceFilePath & _
            SourceFileName & "_Shortened" & "." & SourceFileExtension               ' Set name of new 'shortened' file
'
Debug.Print "Completed in " & Timer - startTime & " Seconds."                       ' Display total run time to 'Immediate window' ... CTRL+G
MsgBox "Completed in " & Timer - startTime & " Seconds."                            ' Display pop up box that alerts user that script is complete
End Sub

This code appears to work at least twice as fast as the code in my previous thread mentioned.

Also let me know if the link to the test file in the previously mentioned thread is no longer valid.

Let me know how it works on those problematic files & anything that needs to be changed.

Right now the code is set up just for excel files with one sheet. If files with with multiple sheets are desired, additional code will be needed.

 

[johnnyL]

Feel free to chime in with your suggestions people!

It takes a village to raise a child. Let's hope it doesn't turn into the village idiot though.

 

[Dan_W]

Let's hope it doesn't turn into the village idiot though

Well, had I known sooner that you were trying to avoid this, I wouldn't have gotten involved! Unfortunately, the village idiot genes run strong in my family...

 

[Dan_W]

I don't see a problem with running the 'WorksheetFix' first, and like you said, it makes more sense to do it that way anyways.

I don't know if you noticed, with regards to the 'calcChain.xml' file, I chose to do a 'calcChainDelete' as opposed to the 'calcChainFix'.
I am not confident in the way the 'calcChainFix' works. It seems to be too specific to the test file. Example, I have seen "i=1" in a few files as well as some other things such as "l=1".
The deletion of the 'calcChain.xml' file seems to work, Excel regenerates it when the excel file is loaded into Excel. It doesn't display an error, it just regenerates it. Excel will not prompt you to save the file either, so you have to save the Excel file in order to save the regenerated 'calcChain.xml'.

Edit: Forgot to mention, In regards to files with multiple sheets, I am not quite sure how the 'calcChainFix' would handle that, considering there is only one 'calcChain.xml' file that covers all of the sheets.

I hadn't noticed that you had reworked calcChainFix into calcChainDelete, but I understand why you would. I was also perplexed with the i= and l= and probably would've responded sooner had it not been for this. Having looked into it, it appears that:

The index attribute i indicates the index of the sheet with which that cell is associated

which makes sense on the face of it, but looking back at the original files source code (from memory), it was showing i="3" for a workbook containing only one worksheet! So insofar as Excel didn't have a problem with it in the original file, I tried throwing it into the revised version. Excel still didn't kick off over it, so in my books (at that time of night), it was good enough for me! LOL

I had planned to look at it again in due course - perhaps with an array of new test files - but I like your approach of just deleting it. My developing concern was that the code was starting to turn into an elaborate OpenXML parsing routine rather than just a quick-n-dirty file fixer. I didn't expect Excel just to regenerate it, so... yay!

Perhaps we should try some more robust testing of the code with a variety of workbooks - comprising 1 sheet/multiples sheets, 1 problematic sheet/multiple problematic sheets - and so on? I will take a look a shifting the code around tomorrow morning.

 

[Dan_W]

Just to let you both know, I like this kind of in-depth research. Thanks for sharing!

Thank you kindly and you're very welcome.
I would just echo what JohnnyL said and add that feedback is encouraged and always greatly appreciated!

 

[johnnyL]

I hadn't noticed that you had reworked calcChainFix into calcChainDelete, but I understand why you would. I was also perplexed with the i= and l= and probably would've responded sooner had it not been for this. Having looked into it, it appears that:

which makes sense on the face of it, but looking back at the original files source code (from memory), it was showing i="3" for a workbook containing only one worksheet! So insofar as Excel didn't have a problem with it in the original file, I tried throwing it into the revised version. Excel still didn't kick off over it, so in my books (at that time of night), it was good enough for me! LOL

You can blame that mislead on me @Dan_W. The test file is comprised of just one sheet that was copied from another workbook that contains more sheets.

I am very sorry for not mentioning that sooner, but up until now, I didn't see how it was relevent.

I can supply the larger workbook, if desired, that contains the sheet being tested here as well as other sheets. That would also show the humongous calcChain.xml file that accompanies it.

Again, my apologies.

 

[rondeondo]

I might be late to the party. When I have a file that refuses to be trimmed I copy the content to a new sheet and delete the old sheet. Usually works.

 

[Dan_W]

I might be late to the party. When I have a file that refuses to be trimmed I copy the content to a new sheet and delete the old sheet. Usually works.

Not at all - the party's just starting! ?
The thought had occurred to us, but decided against it for two reasons:
(1) I was past the point of no return; and
(2) It's objectively far more fun this way!

But, being serious, I think it just morphed from one thing into the next:- at first it was fascinating that the original worksheet XML file clocked in at 40mb in a 2.46mb file, and then it was a question of "what happens if one were to cut this bit out?", and then it was a challenge "can the process be sped up?", and so on.

Your point is a good reminder that it's worth checking against the process you've suggested though. I had originally thought it would just be a matter of transferring the formulas from one sheet to the next, but Johnny had made the very good point that this wouldn't include charts or images, etc. I guess one would need to use the copy/paste method? I'll test that approach, unless you have any suggestions.

 

[johnnyL]

Perhaps we should try some more robust testing of the code with a variety of workbooks - comprising 1 sheet/multiples sheets, 1 problematic sheet/multiple problematic sheets - and so on? I will take a look a shifting the code around tomorrow morning.

Link to file with 2 problem sheets is here <---

It contains 2 sheets, the second one is the same sheet as the previous testing file, but I added a first sheet that also has problems.

Bookcc = $A1048576 CTRL+End Result
Paper 2 =$M1048576 CTRL+End Result

 

[johnnyL]

You can blame that mislead on me @Dan_W. The test file is comprised of just one sheet that was copied from another workbook that contains more sheets.

I am very sorry for not mentioning that sooner, but up until now, I didn't see how it was relevent.

I can supply the larger workbook, if desired, that contains the sheet being tested here as well as other sheets. That would also show the humongous calcChain.xml file that accompanies it.

Again, my apologies.

For completeness, the following link is to the file that originally contained the 'Paper 2' sheet: here <---

 

[johnnyL]

Recently I encountered another problematic file, compliments of a post from @RAJESH1960. It has a couple problematic sheets. File size was 35MB & it has just a little bit of data in it.

With the code in this thread up to now, it still took like 4 runs of the code to completely fix the file down to like 40kb.
sweep 1 18973 Before restart/save 24,499 after open/save
sweep 2 11818 Before restart/save 14,735 after open/save
sweep 3 8497 Before restart/save 11,396 after open/save
sweep 4 44 Before restart/save 47 after open/save

So I figured I would dust off the code from this thread and continue the progress on it. Up to now, the code only looked for one problematic sheet and fix that one sheet.

I decided to make the code loop to fix multiple problematic sheets, This would prevent having to run the code multiple times to get to the end result. The resulting code finishes in under a minute.

I also made a few other code changes. Here is the current version I came up with:

Option Explicit
'
    Dim XML_StartRowDeleteCode                  As Long
    Dim WorksheetsFile                          As Object, WorksheetsFolder     As Object
    Dim ZipFile_Builder_Extracter               As Object
    Dim TemporaryZipFullFilePathNameExtension   As String
    Dim StartingRowToDelete                     As Variant
    Dim TemporaryZipFilePath                    As Variant

Sub PhantomRowsEditV3()
'
' Added some additional code to handle possible oversights
' Rearranged some code to loop through problematic sheets
'
'
'
' Create a copy of the source workbook, and save it as a copy of the original renamed with a ZIP extension
'
    Dim SourceFullName                          As Variant
'
    SourceFullName = Application.GetOpenFilename("Excel Files (*.xls*), *xls*", _
            , "Select (.xlsx, .xlsm, .xlam) file to remove excess rows from")           ' Ask the user to select an excel file
'
    If SourceFullName = False Then Exit Sub                                             ' If no file selected then Exit Sub
'
    StartingRowToDelete = VBA.InputBox("Please provide the row # of the file to start deleting from.", _
            "Enter the start row of the problematic file to start deleting lines from.")
'
    If StartingRowToDelete = vbNullString Then Exit Sub
'
'---------------------------------------------------------------------------------------
'
    Dim StartTime                               As Single
    StartTime = Timer                                                                   ' Start the stopwatch
'
    Dim FileNamePart                            As Long
    Dim EndTimer                                As Single
    Dim AdditionToFileName                      As String
    Dim FullFileNameWithoutExtension            As String
    Dim NewName                                 As String
    Dim FilenameParts                           As Variant
'
    FilenameParts = Split(SourceFullName, ".")                                          ' Split the selected file name into sections separated by '.'
    TemporaryZipFullFilePathNameExtension = Replace(SourceFullName, _
            FilenameParts(UBound(FilenameParts)), "zip")                                ' Change extension of file selected to a zip extension
'
    AdditionToFileName = Format(Now, " dd-mmm-yyyy h-mm-ss")                            ' Use date/time to create unique name to add to selected file name
'
    For FileNamePart = LBound(FilenameParts) To UBound(FilenameParts) - 1               ' Loop through FilenameParts array
        FullFileNameWithoutExtension = FullFileNameWithoutExtension & _
                FilenameParts(FileNamePart) & "."                                       '   Add part of file name to FullFileNameWithoutExtension
    Next                                                                                ' Loop back
'
    FullFileNameWithoutExtension = Left(FullFileNameWithoutExtension, _
            Len(FullFileNameWithoutExtension) - 1)                                      ' Remove the last '.' from the end of FullFileNameWithoutExtension
'
    NewName = FullFileNameWithoutExtension & "_Shortened" & AdditionToFileName & _
            "." & FilenameParts(UBound(FilenameParts))                                  ' Create a new name for the file including the extension
'
    TemporaryZipFilePath = MakeTempDirectory("XMLEDIT")
'
    FileCopy SourceFullName, TemporaryZipFullFilePathNameExtension                      ' Copy and rename original file to a zip file with a unique name
'
    Set ZipFile_Builder_Extracter = CreateObject("Shell.Application")                   ' Create ZipFile_Builder_Extracter
'
'---------------------------------------------------------------------------------------
'
    Call LookForProblematicSheet
'
    Call calcChainDelete                                                                ' Call the calcChainDelete Subroutine
'
    Do
        Call WorksheetFix                                                               '   Call the WorksheetFix Subroutine
'
        Call LookForProblematicSheet
        If XML_StartRowDeleteCode <= 0 Then Exit Do                                     '   If found in the XML file then ...
    Loop
'
    Name TemporaryZipFullFilePathNameExtension As NewName                               ' Change the newly created file extension back to
'                                                                                       '       the original file extention
    EndTimer = Timer - StartTime                                                        ' Stop the stopwatch
    Debug.Print "Completed in " & EndTimer & " Seconds."                                ' Display results to the 'Immediate' window (CTRL+G)
    MsgBox "Completed in " & EndTimer & " Seconds."                                     ' Display pop up box that alerts user that script has completed
End Sub


Private Sub calcChainDelete()
'
'   Delete the 'calcChain.xml' from the zip file because Excel will regenerate it when the new file is loaded into Excel.
'
    Dim CCFile                  As Object, TempObject           As Object, XLDIR    As Object
'
    Set XLDIR = ZipFile_Builder_Extracter.Namespace(TemporaryZipFullFilePathNameExtension & _
            "\xl\")                                                                     ' "xl"
    Set CCFile = XLDIR.items.Item("calcChain.xml")                                      ' "calcChain.xml"
    Set TempObject = ZipFile_Builder_Extracter.Namespace(TemporaryZipFilePath)          ' "XMLEDIT"
'
    If Not CCFile Is Nothing Then
        TempObject.MoveHere CCFile.Path, 20                                             ' Remove 'calcChain.xml' from the zip file
'
        Kill TemporaryZipFilePath & "\" & CCFile                                        ' Delete the calcChain.xml file from the temp folder
    End If
End Sub
'
'---------------------------------------------------------------------------------------
'
''Sub calcChainFix()
'
'   Move calcChainFix.xml from the ZIP container to the temporary directory
'
''    Dim XML_StartRowDeleteCode  As Long
''    Dim First_XML_Section       As String, Second_XML_Section   As String
''    Dim CCFile                  As Object, TempObject           As Object, XLDIR    As Object
''    Dim FinalXML                As String, Original_XML_File    As String, XMLCode  As String
''    Dim nextchar
''    Dim tmpchar
'
''    Set XLDIR = ZipFile_Builder_Extracter.Namespace(TemporaryZipFullFilePathNameExtension & _
            "\xl\")                                                                     ' "xl"
''    Set CCFile = XLDIR.items.Item("calcChain.xml")                                      ' "calcChain.xml"
''    Set TempObject = ZipFile_Builder_Extracter.Namespace(TemporaryZipFilePath)          ' "XMLEDIT"
'
''    TempObject.MoveHere CCFile.Path, 20                                                 ' Move 'calcChain.xml' to the temp folder
'
''    Original_XML_File = TemporaryZipFilePath & "\" & CCFile                             ' Save Full path, File name & Extension of the 'calcChain.xml' file
''    XMLCode = ReadFile(Original_XML_File)
'
' Start editing the XML code
''    XML_StartRowDeleteCode = InStr(XMLCode, "><")
''    nextchar = InStr(XML_StartRowDeleteCode, XMLCode, StartingRowToDelete - 1) - 10
''    nextchar = InStr(CLng(nextchar), XMLCode, "<")
''    First_XML_Section = Left(XMLCode, XML_StartRowDeleteCode)
''    Second_XML_Section = Mid(XMLCode, nextchar)
''    FinalXML = First_XML_Section & Second_XML_Section
''    tmpchar = InStr(XML_StartRowDeleteCode, FinalXML, "/>") - 1
'
''    If InStr(tmpchar, FinalXML, "i=") = 0 Then
''        FinalXML = Left(FinalXML, tmpchar) & " i=""3" & Mid(FinalXML, tmpchar)
''    End If
'
' Replace the existing file and move the new file into the ZIP container
''    Kill Original_XML_File                                                              ' Delete the original XML file from the temp folder
''    CreateFile CStr(Original_XML_File), FinalXML                                        ' Place the editted file version in the temp folder
'
''    XLDIR.MoveHere TempObject.items.Item(0), 20                                         ' Put editted XML file back into zip file
'
''    Do Until TempObject.items.Count = 0                                                 ' Wait till file has finished being placed back into zip file
''        DoEvents
''    Loop
''End Sub

Private Sub LookForProblematicSheet()
'
'   Get the filesize of the workbook containing the problematic worksheet and compare it with the filesizes of each worksheet's uncomopressed XML file.
'
'   If the XML file is larger than the container XLSM/XLSX/ZIP file, then that is strong indication that the worksheet contains the phantom rows.
'
    Dim ZipFileSize         As Long
    Dim FileObject          As Object
'
    ZipFileSize = FileLen(TemporaryZipFullFilePathNameExtension)                        ' Get the size of the file
'
    Set WorksheetsFolder = ZipFile_Builder_Extracter.Namespace(TemporaryZipFullFilePathNameExtension & _
            "\xl\worksheets\")                                                          ' "worksheets"
'
    For Each FileObject In WorksheetsFolder.items                                       ' Loop through each item in the 'worksheets' folder
        If FileObject.Size > ZipFileSize Then                                           '   If a very large file is found then ...
            Set WorksheetsFile = FileObject                                             '       Save the name of the file
            Exit For                                                                    '       Exit the For loop
        End If
    Next                                                                                ' Loop back
'
''    If WorksheetsFile = vbNullString Then                                               ' If a problematic file was not found then ...
''        MsgBox "Abnormally large file was not found"                                    '   Alert user that a problematic file wasn't found
''        End                                                                             ' Exit application
''    End If
End Sub


Private Sub WorksheetFix()

' Move worksheet file from the ZIP container to the temporary directory
    Dim XML_EndRowDeleteCode    As Long
    Dim TempObject              As Object
    Dim FinalXML                As String
    Dim XMLCode                 As String
    Dim First_XML_Section       As String, Second_XML_Section       As String
'
    Set TempObject = ZipFile_Builder_Extracter.Namespace(TemporaryZipFilePath)
    TempObject.MoveHere WorksheetsFile.Path, 20                                         ' Move problematic Large file to the temp folder
'
    XMLCode = ReadFile(TemporaryZipFilePath & "\" & WorksheetsFile)                     ' Read the entire contents of the problematic file into XMLCode
'
' Start editing the XML code
CheckStartingRowToDelete:
    XML_StartRowDeleteCode = InStr(XMLCode, "<row r=" & Chr(34) & _
            CLng(StartingRowToDelete) & Chr(34)) - 1                                    ' Find starting position of XML_StartRowDeleteCode ... 92679
'
    If XML_StartRowDeleteCode > 0 Then                                                  ' If found in the XML file then ...
        XML_EndRowDeleteCode = InStr(XMLCode, "</sheetData>")                           '   Find ending position of XML_StartRowDeleteCode ... 17851904
'
        XMLCode = Left$(XMLCode, XML_StartRowDeleteCode) & Mid$(XMLCode, _
                XML_EndRowDeleteCode)                                                   '
'
        XMLCode = Replace(XMLCode, "1048576", StartingRowToDelete - 1)                  '   Replace the last row flag
        XMLCode = Replace(XMLCode, "zeroHeight=""1""", vbNullString)                    '   Delete the Hidden Rows flag
'
''    Else                                                                                ' Else ...
''        MsgBox "The row chosen to start deleting from does not exist in the XML file."  '   Alert the user that the row number doesn't exist in the file
    End If
'
' Replace the existing file and move the new file into the ZIP container
    Kill TemporaryZipFilePath & "\" & WorksheetsFile                                    ' Delete the original XML file from the temp folder
'
    CreateFile CStr(TemporaryZipFilePath & "\" & WorksheetsFile), XMLCode               ' Place the editted file version in the temp folder
'
    WorksheetsFolder.MoveHere TempObject.items.Item(0), 20                              ' Put editted XML file back into zip file
'
    Do Until TempObject.items.Count = 0                                                 ' Wait till file has finished being placed back into zip file
        DoEvents
    Loop
End Sub
    
Private Sub CreateFile(FileName As String, XML_FileContents As String)
'
    Dim XML_File As Long
'
    XML_File = FreeFile
'
    Open FileName For Output As #XML_File                                               ' Open the XML file
        Print #XML_File, XML_FileContents                                               '   save data back to xml file
    Close #XML_File                                                                     ' Close the XML file
End Sub
    
Function ReadFile(FileName As String) As String
'
'   The ReadFile routine is faster than FileSystemObject for reading the contents of a file.
'
    Dim XML_File            As Long
    Dim XML_FileLength      As Long
    Dim XML_FileContents    As String
'
    XML_File = FreeFile                                                                 '
'
    Open FileName For Binary As #XML_File                                               ' Open the XML file
        XML_FileLength = LOF(XML_File)                                                  '   Get XML_FileLength
        XML_FileContents = Space$(XML_FileLength)                                       '   Create blank XML_FileContents string
        Get #XML_File, , XML_FileContents                                               '   Load contents of XML file into XML_FileContents string
    Close #XML_File                                                                     ' Close the XML file
'
    ReadFile = XML_FileContents                                                         ' Pass XML_FileContents back to the calling Sub
End Function
    
Function MakeTempDirectory(TempFolder As String) As String
'
'   Note that this routine assumes that the directory C:\TEMP already exists.
'
    Dim FolderExists    As String
    Dim TempDir         As String
'
    FolderExists = Dir("C:\TEMP\", vbDirectory)                                         ' Check to see if folder already exists
'
    If FolderExists = "" Then MkDir "C:\TEMP\"                                          ' If folder does not exist then create it
'
    TempDir = "C:\TEMP\" & TempFolder                                                   ' Save full path of folder & Temporary Folder name to TempDir
'
    If Len(Dir(TempDir, vbDirectory)) Then                                              ' If the TempDir exists then ...
        If Dir(TempDir & "\*") <> vbNullString Then                                     '   If there are any files/folders in the TempDir then ...
            Kill TempDir & "\*.*"                                                       '       Delete them
        End If
    Else                                                                                ' Else
        MkDir TempDir                                                                   '   Create the TempDir
    End If
'
    MakeTempDirectory = TempDir
End Function

The link to the multiple problematic sheets file is here.

Comments, questions, concerns are always welcome.

Game on!