VBA sorting mechanism not working on second sheet-CodePudding

I have written a sorting mechanism that activates when you double click on a specific cell in excel. The macro works on the first sheet but not the second sheet, even though the code is practically identical. (First sheet name: New Listings, Second sheet: Identifier changes) I keep getting a "400" error and I don't understand what is responsible for this error.

Can someone please explain to me what is going on, I'd really appreciate it. Thanks

Dim g_sLast_Column As Variant
Dim g_sLast_Sheet As Variant
Dim g_sLast_Sort As Variant

Dim arrWorksheet As String
Dim arrWorksheet2 As String

Dim arrRange As String
Dim arrRange2 As String

Dim arrControlRange() As Variant
Dim arrControlRange2() As Variant

Dim arrSort1 As Variant
Dim arrSort2 As Variant
Dim arrSort3 As Variant
Dim arrSort4 As Variant
Dim arrSort5 As Variant
Dim arrSort6 As Variant

Sub Workbook_Open()

Appication.ScreenUpdating = True


arrWorksheet = ThisWorkbook.Sheets("New Listings").Name
arrWorksheet2 = ThisWorkbook.Sheets("Identifier Changes").Name

arrRange = "A6:G1000"
arrControlRange = Array("A5", "B5", "C5", "D5", "E5", "F5", "G5")
arrSort1 = Array("A", "B", "C", "D", "E", "F", "G")
arrSort2 = Array("B", "F", "F", "F", "F", "E", "A")
arrSort3 = Array("E", "E", "E", "E", "B", "B", "B")

arrRange2 = "A6:H1000"
arrControlRange2 = Array("A5", "B5", "C5", "D5", "E5", "F5", "G5", "H5")
arrSort4 = Array("A", "B", "C", "D", "E", "F", "G", "H")
arrSort5 = Array("F", "F", "F", "F", "A", "B", "B", "F")
arrSort6 = Array("B", "A", "A", "A", "B", "A", "A", "B")

On Error Resume Next

ThisWorkbook.Sheets("New Listings").OnDoubleClick = "thisworkbook.SortMacro"
ThisWorkbook.Sheets("Identifier Changes").OnDoubleClick = "thisworkbook.SortMacro2"

End Sub

Public Sub SortMacro()

iRow = ActiveCell.Row
iColumn = ActiveCell.Column
strCurrCell = Replace(ActiveCell.Address, "$", "")
strSheet = ActiveSheet.Name

If iColumn = g_sLast_Column And strSheet = g_sLast_Sheet Then
    If g_sLast_Sort = xlAscending Then
        vParameter = xlDescending
    Else
        vParameter = xlAscending
    End If
Else
    vParameter = xlAscending
End If
 
'search for the active sheet within the array of sheets controlled by the
            'if the current cell is within the controlling range:
For i = 0 To UBound(arrControlRange)
    If strCurrCell = arrControlRange(i) Then
        strKeyCell1 = arrSort1(i) & ActiveSheet.Range(arrRange).Row
        strKeyCell2 = arrSort2(i) & ActiveSheet.Range(arrRange).Row
        strKeyCell3 = arrSort3(i) & ActiveSheet.Range(arrRange).Row
            ThisWorkbook.Worksheets(arrWorksheet).Range(arrRange).Sort _
                Key1:=Range(strKeyCell1), Order1:=vParameter, _
                Key2:=Range(strKeyCell2), Order2:=vParameter, _
                Key3:=Range(strKeyCell3), Order2:=vParameter, _
                Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
                Orientation:=xlTopToBottom
    End If
Next i

g_sLast_Column = iColumn
g_sLast_Sheet = ActiveSheet.Name
g_sLast_Sort = vParameter
    
End Sub

Public Sub SortMacro2()
    
iRow = ActiveCell.Row
iColumn = ActiveCell.Column
strCurrCell = Replace(ActiveCell.Address, "$", "")
strSheet = ActiveSheet.Name

If iColumn = g_sLast_Column And strSheet = g_sLast_Sheet Then
    If g_sLast_Sort = xlAscending Then
        vParameter = xlDescending
    Else
        vParameter = xlAscending
    End If
Else
    vParameter = xlAscending
End If
 
'search for the active sheet within the array of sheets controlled by the
            'if the current cell is within the controlling range:
For i = 0 To UBound(arrControlRange2)
    If strCurrCell = arrControlRange2(i) Then
        strKeyCell1 = arrSort4(i) & ActiveSheet.Range(arrRange2).Row
        strKeyCell2 = arrSort5(i) & ActiveSheet.Range(arrRange2).Row
        strKeyCell3 = arrSort6(i) & ActiveSheet.Range(arrRange2).Row
            ThisWorkbook.Worksheets(arrWorksheet2).Range(arrRange2).Sort _
                Key1:=Range(strKeyCell1), Order1:=vParameter, _
                Key2:=Range(strKeyCell2), Order2:=vParameter, _
                Key3:=Range(strKeyCell3), Order2:=vParameter, _
                Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
                Orientation:=xlTopToBottom
    End If
Next i

g_sLast_Column = iColumn
g_sLast_Sheet = ActiveSheet.Name
g_sLast_Sort = vParameter
    
End Sub

CodePudding user response：

Here's a slightly more easily-configured approach to this:

In ThisWorkbook:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
                                  ByVal Target As Range, Cancel As Boolean)
    Cancel = HandleSort(Target) 'call the sorting method - cancel if a header was clicked
End Sub

In a regular module:

'Called from Workbook_SheetBeforeDoubleClick event handler
Public Function HandleSort(c As Range) As Boolean

    Static LastColumn, LastSheet, LastSort  'avoids use of Globals
    
    Dim config, ws As Worksheet, sortRange As Range, arrControlRange
    Dim i As Long, arrSort1, arrSort2, arrSort3, addr, SortOrder, keysRow As Range
    
    Set ws = c.Parent
    config = SortConfig(ws)
    If IsEmpty(config) Then Exit Function 'nothing to sort on this sheet
    
    arrControlRange = config(1)
    addr = c.Address(False, False) 'no $
    
    'search for the active sheet within the array of sheets controlled by the
            'if the current cell is within the controlling range:
    For i = 0 To UBound(arrControlRange)
        If addr = arrControlRange(i) Then
            
            If c.Column = LastColumn And ws.Name = LastSheet Then
                SortOrder = IIf(LastSort = xlAscending, xlDescending, xlAscending) 'reverse previous
            Else
                SortOrder = xlAscending 'default sort order
            End If
            
            Set sortRange = ws.Range(config(0))
            arrSort1 = config(2)
            arrSort2 = config(3)
            arrSort3 = config(4)
            
            Set keysRow = sortRange.Rows(1).EntireRow 'sort keys are on this row
            
            sortRange.Sort _
                Key1:=keysRow.Columns(arrSort1(i)), Order1:=SortOrder, _
                Key2:=keysRow.Columns(arrSort2(i)), Order2:=SortOrder, _
                Key3:=keysRow.Columns(arrSort3(i)), Order2:=SortOrder, _
                Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
                Orientation:=xlTopToBottom
            
            LastSort = SortOrder     'save settings
            LastColumn = c.Column
            LastSheet = ws.Name
            HandleSort = True        'pass back to event handler to cancel edit mode on cell
            Exit For                 'no need to loop further
        End If
    Next i
End Function

'Given a worksheet, see if we have Sort configuration to return
'  Returning an array, but a simple class might be better-suited
Function SortConfig(ws As Worksheet)
    
    Select Case ws.Name
        Case "NewListings"
            SortConfig = Array("A6:G20", _
                            Array("A5", "B5", "C5", "D5", "E5", "F5", "G5"), _
                            Array("A", "B", "C", "D", "E", "F", "G"), _
                            Array("B", "F", "F", "F", "F", "E", "A"), _
                            Array("E", "E", "E", "E", "B", "B", "B"))
        
        Case "Identifier Changes"
            SortConfig = Array("A6:H20", _
                            Array("A5", "B5", "C5", "D5", "E5", "F5", "G5", "H5"), _
                            Array("A", "B", "C", "D", "E", "F", "G", "H"), _
                            Array("F", "F", "F", "F", "A", "B", "B", "F"), _
                            Array("B", "A", "A", "A", "B", "A", "A", "B"))
        Case Else
            SortConfig = Empty 'no config for the passed sheet
    End Select
    
End Function

Additional sheets can be added just by modifying SortConfig