Problem With Content Error

[Veritan]

Hello, I am trying to resolve an issue with an error I am getting when I open some of my workbooks. The error text is "We found a problem with some content in 'TODAY.xlsm'. Do you want us to try to recover as much as we can? If you trust the source of this workbook, click Yes." When I click Yes, the file opens correctly but shows a dialog box with a list of repairs. The repairs say something like "Removed Records: Sorting from /xl/worksheets/sheet3.xml part". There is a link to a log listing the repairs. The log is an xml file with some information about the worksheet (log can be provided if necessary).

I've narrowed this issue down to some automatic sorting that I have. I have 3 tabs named "3rd - Summary", "1st - Summary", and "2nd - Summary". The tabs are used to keep track of parts made on each shift. All 3 tabs have the following event code in them:

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Call Sorting
    Application.ScreenUpdating = True
End Sub

This calls a sub in a module (named modSorting) that has this code in it:

Option Explicit


Sub Sorting()
    If Cells(Rows.Count, 1).End(xlUp).Row <= Range("A1").End(xlDown).Row + 1 Then Exit Sub
    
    With ActiveSheet.Sort
        With .SortFields
            .Clear
            .Add Key:=Cells(4, 2), CustomOrder:=GetSortOrder
            .Add Key:=Cells(4, 3), Order:=xlAscending
        End With
        .SetRange Range("A4", Cells(Rows.Count, 1).End(xlUp).Offset(, 10))
        .Header = xlYes
        .Apply
    End With
End Sub


Function GetSortOrder()
    Dim r As Range, aryList() As String, colList As Collection, i As Integer, SortOrder As String
    
    Set colList = New Collection
    With Sheets("Priority")
        For Each r In .Range("A3", .Cells(Rows.Count, 1).End(xlUp))
            On Error Resume Next
            colList.Add r, CStr(r)
            On Error GoTo 0
        Next r
    End With
    ReDim aryList(1 To colList.Count)
    For i = LBound(aryList) To UBound(aryList)
        aryList(i) = colList(i)
        If Not i = LBound(aryList) And colList(i) <> "" Then
            SortOrder = SortOrder & ", " & aryList(i)
        ElseIf colList(i) <> "" Then
            SortOrder = SortOrder & aryList(i)
        End If
    Next i
    GetSortOrder = SortOrder
    Erase aryList
    Set colList = Nothing
End Function

The GetSortOrder function is designed to extract unique values from the "Priority" tab and use them to create a custom sort order. What I've found is that as long as I have no records or just 1 record in any of the Summary tabs, everything is fine. However, the Summary tabs are supposed to hold data from dozens of people regarding the work they did that day, so the tabs should have numerous records in them. Whenever I have more than 1 record in any given tab, I get the error I mentioned above. Clicking Yes will open the file but the title becomes "TODAY.xlsm [Repaired]" and I am forced to either save over the correct file name or choose a new name. Does anyone know of a way to resolve this issue? FYI, I have additional code in the file, but I have extensively tested numerous permutations of having or not having code sections and the only time the issue pops up is when I have multiple records in a single Summary tab and the sorting code is active. I even created a brand new workbook from scratch, carefully adding in all tabs in sequential order and manually typing in all the code since I have seen some posts that the issue can be related to the xml files having a mismatch in sheet names. Unfortunately, this did not resolve the issue either.

Thank you in advance for helping with this.

 

[Veritan]

Update: Issue Solved

It appears that the issue was due to how Excel handles custom sort order strings. I found that after the first "End With" statement in the Sorting sub, Excel would actually create a second custom sort order. This could be viewed by selecting the data to be sorted, clicking the Sort button in the Data tab, and then selecting the Order drop-down. The first custom order was the correct one that the code had dynamically generated. But for some obscure reason, there was a second list that was exactly identical to the first list, except in reverse order. However, when I selected the Custom List... option, only the first list was available.

I solved the issue by adjusting the code to include a single line I found from this thread (many thanks to RogerDodger for coming up with the original solution):

Sub Sorting()
    If Cells(Rows.Count, 1).End(xlUp).Row <= Range("A1").End(xlDown).Row + 1 Then Exit Sub
    
    With ActiveSheet.Sort
        With .SortFields
            .Clear
            .Add Key:=Cells(4, 2), CustomOrder:=GetSortOrder
            .Add Key:=Cells(4, 3), Order:=xlAscending
        End With
        [COLOR=#008000]'When the SetRange line executes, that is when the reverse order list appears.[/COLOR]
        .SetRange Range("A4", Cells(Rows.Count, 1).End(xlUp).Offset(, 10))
        .Header = xlYes
        .Apply
[COLOR=#ff0000]        .SortFields.Clear[/COLOR]
    End With
End Sub

Just for my personal learning experience, does anyone who knows the ins and outs of Excel much better than I do know why this solution worked? It seems a very odd approach that the XML files can't handle custom sort orders properly.