Excel VBA sort sometimes stops (but doesn't error)

[ko1967]

This one has been driving me nuts for some time so I'm hoping one of the knowledgeable people here has an answer.

I have a massive spreadsheet (11 MB and growing) that I use to track stock trading data. Imbedded w/i the spreadsheet are many RTD functions calling ToS to get real time data on stocks/options/futures. I have the following code which sorts 4 tables on 4 different tabs. The problem is that sometimes (not all the time) the tblOpenPos table will not sort. The 3 other tables will sort and the VBA does not error out in the case where the tblOpenPos tab does not sort. I set Application.Calculation = xlCalculationManual to stop the RTD function from returning data during the sort. And I actually set it to manual before each sort because I read a post that indicated that if there are calculations in a table that is sorted that the sort will force a recalc. And most of the time when the macro returns and the data is not sorted I can click the button to call the macro again and it will sort this time.

Any help is greatly appreciated. Thanks.

Sub Sort()'
' Sort Macro
' Sorts TLog, CLog, Activity, and OpenPos tabs.
'
'
    Dim xlCalcMode As XlCalculation
    
    Application.ScreenUpdating = False
    
    ' save current calculation mode
    xlCalcMode = Application.Calculation
    ' set calculation mode to manual to speed up sort process
    Application.Calculation = xlCalculationManual
    
    ' sort Tlog
    Sheet2.Select
    With Sheet2.ListObjects("tblTLog").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("tblTLog[Closed]"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblTLog[CID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblTLog[TID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' Auto update row height of all rows on the sheet
    Call AutoRowHeight
    
    ' sort CLog
    Sheet20.Select
    With Sheet20.ListObjects("tblCLog").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("tblCLog[CloseDt]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblCLog[CID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' Auto update row height of all rows on the sheet
    Call AutoRowHeight
    
    Application.Calculation = xlCalculationManual
    ' sort Activity
    Sheet23.Select
    With Sheet23.ListObjects("tblActivity").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("tblActivity[CID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblActivity[TID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Call AutoRowHeight


    Application.Calculation = xlCalculationManual
    ' sort Open Positions
    Sheet14.Select
    With Sheet14.ListObjects("tblOpenPos").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("tblOpenPos[Sort]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblOpenPos[AID]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblOpenPos[CID]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblOpenPos[Sort2]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblOpenPos[Expiration]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblOpenPos[Strike]"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblOpenPos[PC]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tblOpenPos[OpenDt]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    Call UpdateHighLow
    
    ' Restore calculation mode to what it was when subroutine was called
    Application.Calculation = xlCalcMode
    
End Sub

Sub AutoRowHeight()
'
' rowheight Macro - autofit all row height in currently selected worksheet
'
    Cells.Select
    Cells.EntireRow.AutoFit


End Sub

 

[ko1967]

ps. The first column in tblOpenPos = [TID] is populated using this function (i.e. it pulls a unique list from the tblTLog table).

{=IFERROR(INDEX(tblTLog[TID],SMALL(IF((tblTLog[CloseDt]="")+(tblTLog[CID]<>"")=2,ROW(tblTLog[TID])-ROW(TLog!$A$1)),ROWS(TLog!$A$1:$A1))),"")}

 

[ko1967]

Closing out my own thread as I found the following solution.

Within the tblTLog table I established a [OSID] column where I concat the various fields originally specified in the VBA sort code for the tblOpenPos table. This establishes 1 field for sorting. Then I established a [Rank] column in the tblTLog table with the following function which ranks the [OSID] column (1 to n) in the sort order specified by the [OSID] field while ignoring blank cells and cells that evaluate to "".

[Rank] =IF([@OSID]="","",SUMPRODUCT(--([OSID]<>""),--([OSID]<[@OSID]))+1)

Then in the OpenPos table in the [TID] column is have the function which pulls TID (unique identifier) from tblTLog where the row (1 to n) in the tblOpenPos table matches the Rank in the tblTlog table.

[TID]=IFERROR(INDEX(tblTLog,MATCH(ROW()-ROW(tblOpenPos[#Headers]),tblTLog[Rank],0),MATCH(A$9,tblTLog[#Headers],0)),"")

... and BONUS ... one less array formula