I'm trying to use vba to sort tabs in Excel, but I'm not familiar enough with writing the code to alter existing answers that I've found online.
I have multiple Excel files, each with different numbering systems. Those include Item (#ofsheet), so like Item (1), Item (8), Item (28). Those organize themselves by Item 1, 28, and 8 when I try existing codes, when it should be 1, 8, 28.
Would someone help me with the code for this? Thank you.
Edit: my apologizes, I wrote this on my phone originally. This code is working for me to get the items into a Item (1), Item (11), Item (2), Item (34) order.
Sub sortAscendinfg()
Dim i, N, k As Double
'Count the number of worksheets and store the number in variable "n"
N = Application.Sheets.Count
'Do the following look for each worksheet again
For i = 1 To N
'Loop through all worksheets until the second last one (later you use the .move after function)
For k = 1 To N - 1
'If the name is larger than the following worksheet, change the sequence of these two worksheets.
'In order to enable a proper comparison, change all characters to lower case (UCase = Upper case works
'the same way.
If LCase(Sheets(k).Name) > LCase(Sheets(k 1).Name) Then Sheets(k).Move After:=Sheets(k 1)
Next
Next
End Sub
CodePudding user response:
This may be able to be done better and without seeing your code, I have no idea where you're going wrong but I suggest as a string, if you're treating it that way, 8 is greater than 28.
You can test this by going into the immediate window in the VBA editor and entering and hitting enter ...
?str(8) > str(28)
... the result is true. Not what you want.
Try this, it worked for me.
There are a couple of caveats though, there can be no other opening or closing brackets in the name of the worksheet other than those you have at the end as you've specified, e.g. "Item (28)" ... this won't be ok, "Item (other brackets) (28)"
Public Sub SortSheets()
Dim objSheet As Worksheet, objSubSheet as Worksheet
Dim lngSortOrder As Long, lngSortSubOrder As Long
For Each objSheet In ThisWorkbook.Worksheets
lngSortOrder = Replace(Split(objSheet.Name, "(")(1), ")", "")
For Each objSubSheet In ThisWorkbook.Worksheets
lngSortSubOrder = Replace(Split(objSubSheet.Name, "(")(1), ")", "")
If lngSortOrder < lngSortSubOrder Then
objSheet.Move Before:=Sheets(objSubSheet.Index)
Exit For
End If
Next
Next
End Sub
CodePudding user response:
Sort Incrementing Sheets
- The
SortIncrementingSheetsTEST
procedure is an example of how to use (call) the mainSortIncrementingSheets
procedure. - The main
SortIncrementingSheets
procedure needs theGetLastInteger
procedure to work. - The
GetLastInteger
procedure returns the last integer (the last consecutive digits as a number) found in a string. - The
GetLastIntegerTEST
procedure is an example of how to use (call) theGetLastInteger
procedure. It prints13
in the Immediate window since13
is the last integer in the example stringSheet1(013)
. - Basically, all the sheet names and their corresponding last integers are written to the
Keys
andItems
of adictionary
, which is then utilized when sorting the sheets. Uncomment theDebug.Print
lines to better understand how the procedure works by reviewing the results in the Immediate window. - The sort in the procedure is based on the following Microsoft Docs article by
MVP Tom Urtis
:
Sort Worksheets Alphanumerically by Name
Option Explicit
Sub SortIncrementingSheetsTEST()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
SortIncrementingSheets wb
End Sub
Sub SortIncrementingSheets( _
ByVal wb As Workbook)
' Needs 'GetLastInteger'.
If wb Is Nothing Then Exit Sub
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim sh As Object
For Each sh In wb.Sheets
dict.Add sh.Name, GetLastInteger(sh.Name)
Next sh
'Debug.Print Join(dict.Keys, ",")
'Debug.Print Join(dict.Items, ",")
Dim shCount As Long: shCount = wb.Sheets.Count
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
For i = 1 To shCount - 1
For j = i 1 To shCount
If dict(wb.Sheets(j).Name) < dict(wb.Sheets(i).Name) Then
wb.Sheets(j).Move Before:=wb.Sheets(i)
'Debug.Print "Moved '" & wb.Sheets(i).Name & "' from '" _
& j & " to " & i & "'."
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "Sheets sorted.", vbInformation
End Sub
Function GetLastInteger( _
ByVal SearchString As String) _
As Long
Dim nLen As Long: nLen = Len(SearchString)
Dim DigitString As String
Dim CurrentChar As String
Dim n As Long
Dim FoundDigit As Boolean
For n = nLen To 1 Step -1
CurrentChar = Mid(SearchString, n, 1)
If CurrentChar Like "#" Then ' it's a digit
DigitString = CurrentChar & DigitString
If Not FoundDigit Then
FoundDigit = True
End If
Else ' it's not a digit
If FoundDigit Then
Exit For
End If
End If
Next n
If FoundDigit Then
GetLastInteger = CLng(DigitString)
Else
GetLastInteger = -1
End If
End Function
Sub GetLastIntegerTEST()
Debug.Print GetLastInteger("Sheet1(013)")
End Sub