Monday, March 14, 2016

Excel VBA Macro to sort sheet having Alpha numeric name

Query: I want to sort sheet in Ascending or Descending order, please not it has Alpha numeric name so I want sort it in serial order e.g. A1,A2,A3,A11,A12 and not A1,A11,A12,A2,A3

Solution: when comes to sorting 1, 11 & 111 are considered as same picture character resulting into sorting sheet incorrectly, try below code to get desired results:

```Sub Sort_Active_Book_AlphaNum()

Dim i As Integer

Dim j As Integer

Dim a As Integer, b As Integer, Sn1 As String, Sn2 As String

Dim c As String

'

' Prompt the user as which direction they wish to

' sort the worksheets.

'

iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _

& "Clicking No will sort in Descending Order", _

vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")

For i = 1 To Sheets.Count

For j = 1 To Sheets.Count - 1 'Sheets.Count - 1

'

' If the answer is Yes, then sort in ascending order.

'

Sn1 = "": Sn2 = ""

For a = 1 To Len(Sheets(j).Name)

If VBA.IsNumeric(Mid(Sheets(j).Name, a, 1)) Then

Sn1 = Sn1 & Mid(Sheets(j).Name, a, 1)

End If

Next a

For b = 1 To Len(Sheets(j + 1).Name)

If VBA.IsNumeric(Mid(Sheets(j + 1).Name, b, 1)) Then

Sn2 = Sn2 & Mid(Sheets(j + 1).Name, b, 1)

End If

Next b

If a <> 0 Then

If Val(Sn1) > Val(Sn2) Then

Sheets(j).Move After:=Sheets(j + 1)

End If

Else

If UCase\$(Sheets(j).Name) > UCase\$(Sheets(j + 1).Name) Then

Sheets(j).Move After:=Sheets(j + 1)

End If

End If

'

' If the answer is No, then sort in descending order.

'

Sn1 = "": Sn2 = ""

For a = 1 To Len(Sheets(j).Name)

If VBA.IsNumeric(Mid(Sheets(j).Name, a, 1)) Then

Sn1 = Sn1 & Mid(Sheets(j).Name, a, 1)

End If

Next a

For b = 1 To Len(Sheets(j + 1).Name)

If VBA.IsNumeric(Mid(Sheets(j + 1).Name, b, 1)) Then

Sn2 = Sn2 & Mid(Sheets(j + 1).Name, b, 1)

End If

Next b

If a <> 0 Then

If Val(Sn1) < Val(Sn2) Then

Sheets(j).Move After:=Sheets(j + 1)

End If

Else

If UCase\$(Sheets(j).Name) < UCase\$(Sheets(j + 1).Name) Then

Sheets(j).Move After:=Sheets(j + 1)

End If

End If

End If

Next j

Next i

End Sub

```

Cheers!!