Can anyone help me with an alphanumeric sorting code for multiple columns sorting (column by column sorting) advance.

Also let me know If the following code can be used for multiple columns:

Also let me know If the following code can be used for multiple columns:

Code:

Sub sortAlphaNumericMulti() Dim i As Long 'Loop counter Dim lrow As Long 'Last row of data Dim nrow As Long 'New lastrow after copy Dim lcol As Long 'Last col of data, this row 'Presumes data in Col A and Row 1 has maximum extents 'Get last row of data Col A (+1 for first blank row) lrow = Range("A65536").End(xlUp).Row + 1 'Variable for compare nrow = lrow 'Get last column of data (row 1) lcol = Range("IV1").End(xlToLeft).Column 'Use empty space as storage, splitting cell values 'Loop on all rows For i = 1 To lrow - 1 'Get alpha Cells(nrow, 1) = Left(Cells(i, 1), 3) 'Get numeric Cells(nrow, 2) = Left(Cells(i, 1), Len(Cells(i, 1)) - 3) 'Copy rest of data Range(Cells(i, 2), Cells(i, lcol)).Copy Cells(nrow, 3) 'Increment row nrow = nrow + 1 Next i 'Sort by numeric then alpha Range(Cells(lrow, 1), Cells(nrow - 1, lcol + 1)).Select Selection.Sort _ Key1:=Range("B" & lrow), Order1:=xlAscending, _ Key2:=Range("A" & lrow), Order2:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom 'Copy/Paste back 'where to work nrow = lrow 'Loop on all cells For i = 1 To lrow - 1 'Rebuild original values Cells(i, 1) = Cells(nrow, 1) & Cells(nrow, 2) 'Copy sorted Range(Cells(nrow, 3), Cells(nrow, lcol + 1)).Copy Cells(i, 2) 'Increment row nrow = nrow + 1 Next i 'Delete temp(working)range Range(Cells(lrow, 1), Cells(nrow - 1, lcol + 1)).ClearContents Application.ScreenUpdating = True End Sub

## Comment