order worksheets based on name 2

[pookie312]

I have a workbook with 9 worksheets that are populated based on other workbooks. I also need to add other worksheets to this workbook from other workbooks. After all the worksheets are in the one workbook, I would like to put them in a specific order based on the sheet name. I have the code to copy all of the worksheets into one workbook, I just need some help on how to put them in a specific order. Any help is greatly appreciated! Thanks!

 

[PHV]

A starting point:

Sub sortSheets()
Dim i As Integer, j As Integer
For i = 1 To Worksheets.Count - 1
  For j = i + 1 To Worksheets.Count
    If UCase(Worksheets(i).Name) > UCase(Worksheets(j).Name) Then
      Worksheets(j).Move before:=Worksheets(i)
      i = i - 1
      Exit For
    End If
  Next
Next
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[BobStubbs]

Here is a simple 'bubble sort' which will sort sheets into alphabetical order by name:

Private Sub CommandButton1_Click()
    
Dim bChanges As Boolean
Dim iCounter As Integer

Do
    bChanges = False
    For iCounter = 1 To Sheets.Count - 1
        If Sheets(iCounter).Name > Sheets(iCounter + 1).Name  Then
            Sheets(iCounter).Select
            Sheets(iCounter).Move After:=Sheets(iCounter + 1)
            bChanges = True
        End If
    Next iCounter
Loop Until bChanges = False

End Sub

Note that bubble sorting is not a very efficient sort method, but this is fast enough for a dozen or so sheets in a workbook.

If you needed something really fast, you could adapt the idea but use a faster sorting algorithm.

I hope that this is helpful.

Bob Stubbs (London, UK)

 

[pookie312]

Thanks for the responses guys. To add to what I said before, I don't want the sheets in alpha order. I have an order that I would like the sheets in, but it's not alpha or number. Is there a way to store the names of the sheets in an array and then put them in the order based on another array? Thanks.

 

[TonyJollans]

Hi pookie312,

Much easier than a sort. What about:

[blue]SheetOrder = Array("Sheet1", "Sheet3", "Sheet2", "Sheet5", "Sheet4") [green]' Required Order[/green]
For i = UBound(SheetOrder) To LBound(SheetOrder) + 1 Step -1
    Sheets(SheetOrder(i)).Move After:=Sheets(SheetOrder(LBound(SheetOrder)))
Next[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[BobStubbs]

Here is another sorting routine, which I think does what you require. It includes an array, in which you write the sheet names, in the order you want them to be sorted. It also includes error checking for the wrong number of sheets, or a sheet with an unexpected name.

I have included a sheet called @CONTROL to hold the command button - the '@' sign means it will always end up on the left, and hence be easy to find.

Private Sub CommandButton1_Click()

Dim bMovedFlag As Boolean
Dim bNameCheck As Boolean

Dim I As Integer
Dim J As Integer

Dim strOneSheet As String

'-------------------------------------------
'- Dimension this array to hold the number -
'- of sheets in the workbook               -
'-------------------------------------------
Dim strSheetName(6) As String

'-------------------------------------------
'- Set up your sheet names, in upper case, -
'- in the order you wish them to be sorted -
'-------------------------------------------
strSheetName(1) = "@CONTROL"
strSheetName(2) = "FRED"
strSheetName(3) = "GEORGE"
strSheetName(4) = "BETTY"
strSheetName(5) = "HARRY"
strSheetName(6) = "CHRIS"

'-------------------------------------------
'- Error checking                          -
'-------------------------------------------
If Sheets.Count <> UBound(strSheetName) Then
    MsgBox "Incorrect number of sheets in workbbook!", vbExclamation, "Sheet Sorter"
    Exit Sub
End If

For I = 1 To 6
    bNameCheck = False
    For J = 1 To 6
        If UCase$(Sheets(I).Name) = strSheetName(J) Then
            bNameCheck = True
        End If
    Next J
    If bNameCheck = False Then
        MsgBox Sheets(I).Name & " - Unknown sheet found - sort cancelled!", vbExclamation, "Sheet Sorter"
        Exit Sub
    End If
Next I

'-------------------------------------------
'- This loop performs the sort             -
'-------------------------------------------
Do
    bMovedFlag = False
    For I = 1 To 6
        strOneSheet = UCase$(Sheets(I).Name)
        bNameCheck = False
        For J = 1 To 6
            If strSheetName(J) = strOneSheet And I <> J Then
                Sheets(I).Move After:=Sheets(J)
                bMovedFlag = True
            End If
        Next J
    Next I
Loop Until bMovedFlag = False

MsgBox "Sheet sorting completed", vbInformation, "Sheet Sorter"

End Sub

Bob Stubbs (London, UK)

 

[pookie312]

Thanks guys! I tried both of your suggestions and neither one worked. Maybe I missed something. Tony, yours errors out at this statement Sheets(SheetOrder(i)).Move After:=Sheets(SheetOrder(LBound(SheetOrder))) Subscript out of range error 9. Bob, yours runs through and says it is complete, but it doesn't sort the sheets. Any suggestions? Thanks.

 

[TonyJollans]

Hi pookie312,

I can't see any reason why - assuming you've replaced "Sheet1" etc with your own names.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[pookie312]

Tony,

Yes I did replace with my own names. Are the names case sensitive?

 

[TonyJollans]

They shouldn't be. Does it error first time round the loop or later?

One possibility is leading or trailing spaces so you could try:
[blue][tt]Sheets(trim(sheetorder(i))).Move After:=Sheets(trim(sheetorder(LBound(sheetorder))))[/tt][/blue]

If that doesn't work can you post full details - actual names, actual code, etc.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[pookie312]

That didn't work. When it errors out:
SheetOrder(I) - "Two Months Originations"
SheetOrder(LBound(SheetOrder))="Review Findings - CA use ONLY"
LBound(SheetOrder) = 0

Sub MergeSheets()
    
   'Variable defines
   Dim currbook As Workbook
   Dim currsheet As Worksheet
   Dim s As Worksheet
   Dim I As Integer
   Dim J As Integer
   Dim sCount As Integer
   Dim closeBooks() As Workbook
   Dim WSNames() As String
   
   'Begin logic here
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   
   'Iterate over all of the workbooks and copy all sheets to the new workbook
   z = ThisWorkbook.Sheets.Count
   p = 1
   cnt = Workbooks.Count
   For x = 1 To cnt
   If Workbooks(x).Name <> ThisWorkbook.Name Then
        Cells.Select
        Cells.EntireColumn.AutoFit
        Range("A1").Select
        Set currbook = Workbooks(x)
        ReDim Preserve closeBooks(1 To p)
        Set closeBooks(p) = currbook
        p = p + 1
        For y = 1 To currbook.Sheets.Count
            Set currsheet = currbook.Sheets(y)
            currsheet.Copy After:=ThisWorkbook.Sheets(z)
        z = z + 1
        Next y
    End If
    Next x
    
    Dim SheetOrder As Variant
    
    SheetOrder = Array("Review Findings - CA use ONLY", "Previous Issues", "Summary", "Average Trend", "Average Trend Graph", "Weighted Average Trend", "Avg WA Diff", "Delq Trending", "Paid Ahead Trending", "Delinq Class - By Branch", "180 Plus Delinquent Accounts", "Recency Delinq Class - Company", "Recency Delinq Class - By Branch", "Outstandings By Branch", "Expired Term Loans", "First Payment Defaults", "Paid Ahead 120 Plus Loans", "Originations By Month", "Originations By Quarter", "Company Loan Concentrations", "Multiple Loan Concentrations", "Duplicate VINs", "Duplicate SSNs", "Invalid SSNs", "Advertising SSN 1", "Advertising SSN 2", "High APR Loans", "Less Than 10 Percent APR Loans", "Negative APR Loans", "Year of Auto Classification", "Rescheduled Bankruptcy Loans", "Rescheduled Loans", "Loans with Bal Greater than 800", "Two Months Originations") ' Required Order
    For I = UBound(SheetOrder) To LBound(SheetOrder) + 1 Step -1
        Sheets(Trim(SheetOrder(I))).Move After:=Sheets(Trim(SheetOrder(LBound(SheetOrder))))
    Next

    For x = 1 To UBound(closeBooks)
        closeBooks(x).Close
    Next x
    
    AddDetails
    
End Sub

Sub GetSheetsToMerge()
    MsgBox "Select worksheets to add to Workbook"
    Dim odlg As Dialog
    Set odlg = Application.Dialogs(xlDialogOpen)
    
    tf = odlg.Show()
    If tf = True Then
        MergeSheets
    End If
End Sub

 

[TonyJollans]

Hi pookie312,

I just tried to create sheets with your names and it doesn't like "Recency Delinq Class - By Branch" (it's too long) so is it possible that you've made a typo? Not that I can see how that would cause your error.

Also I realised that my trim code is useless - if there are extra spaces in the sheet names it's no good trimming the strings in the code - sorry!

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[

 

[BobStubbs]

Here are three things to check ...

1. I wrote my routine assuming an array base of 1, i.e. strSheetName(0) is never used. This was to allow for anyone using the Option Base 1 command. Maybe your use of the (0) array position affects things.

2. I used UCase$ to make sure that any comparisons would not be affected by case differences in the names.

3. Your array is a variant, not a string.

I copied six of your sheet names taken at random into my test sheet, and my routine sorted them into the required order.


Bob Stubbs (London, UK)

 

[BobStubbs]

I have just seen TonyJollans post ...

I agree with him about the name length. There's a limit of 31 characters in a sheet name (in Excel 2000 anyway). You could add checking code like this:

For I = 1 To UBound(SheetOrder)
    If Len(SheetOrder(I)) > 31 Then
        MsgBox "Sheet name too long: " & SheetOrder(I)
    End If
Next I

... to avoid any typos etc affecting your routine.

Bob Stubbs (London, UK)

 

[jcrater]

Put shorter text values or even numbers in the sheet code names and sort on those.

 

[pookie312]

Thank you Tony and Bob for all of your help. I finally got it to work. I had a couple typos on the worksheet names, but it works beautifully now. Thanks again!