Option Explicit
Sub SortAllColumns()
' constants
Const ksWS = "Sheet3"
' declarations
Dim I As Integer
' start
' remove this and next line, they're just for testing purposes
Worksheets("Sample").Range("A2:D13").Copy Worksheets("Sheet3").Range("A2")
' process
With Worksheets(ksWS)
For I = 1 To .Columns.Count
If .Cells(1, I).Value = "" Then Exit For
SortAColumn ksWS, I
Next I
End With
' end
Beep
End Sub
Sub SortAColumn(psSheet As String, piColumn As Integer)
' constants
Const ksSeparator = "="
' declarations
Dim lLast As Long, iNumI As Integer, iNumJ As Integer, sStrI As String, sStrJ As String
Dim I As Long, J As Long, K As Integer, A As String
' start
' process
With Worksheets(psSheet).Columns(piColumn)
' last row
If .Cells(.Rows.Count, 1).Value = "" Then
lLast = .Cells(.Rows.Count, 1).End(xlUp).Row
Else
lLast = .Rows.Count
End If
' sort
For I = 2 To lLast - 1
A = .Cells(I, 1).Value
K = InStr(A, ksSeparator)
iNumI = Val(Trim(Left(A, K - 1)))
sStrI = Trim(Right(A, Len(A) - K))
For J = I + 1 To lLast
A = .Cells(J, 1).Value
K = InStr(A, ksSeparator)
iNumJ = Val(Trim(Left(A, K - 1)))
sStrJ = Trim(Right(A, Len(A) - K))
If iNumI < iNumJ Or (iNumI = iNumJ And sStrI > sStrJ) Then
' swap
K = iNumI
iNumI = iNumJ
iNumJ = K
A = sStrI
sStrI = sStrJ
sStrJ = A
A = .Cells(I, 1).Value
.Cells(I, 1).Value = .Cells(J, 1).Value
.Cells(J, 1).Value = A
End If
Next J
Next I
End With
' end
End Sub