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 iAnswer As VbMsgBoxResult

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.

'

         If iAnswer = vbYes Then

            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.

'

         ElseIf iAnswer = vbNo Then

          

            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!!

No comments:

Post a Comment