Putting the worksheets in order...

ok what this is is a excel file that I made to keep up with @ work. Like if I have something to do I don't want to forget it the next day and its also a workbook that I have other things in for myself in case I need it in the future.
I made a FindSheet macro that pops up all the sheets in a listbox and its pretty much working. I'm just trying to get the worksheets to change in what order there in in the list box. I'll take a pic of it so you know what I'm talking about for sure. What it does is take whatever the .Listboxes order is and puts the worksheets in that order when the button is pressed. Well I keep getting an error with my code and I was wondering if anyone out there new what it was supposed to say. I think the problem is that where it says:
"sheet2 = UCase(Sheets(i + 1).Name)" the problem is that "i + 1". If there is say 15 worksheets its trying to go to 16. I'm sure there's something in here that I didn't type so don't be afraid to ask me any questions.

Code:

---

Private Sub cmdPoolThem_Click()
Dim flag As Integer Dim i As Integer
Dim temp As String
Dim sheet1 As String
Dim sheet2 As String
For i = 1 To (Sheets.Count)
    sheet1 = UCase(Sheets(i).Name)
    sheet2 = UCase(Sheets(i + 1).Name)
    If sheet1 < sheet2 Then
        Sheets(i).Move after:=Sheets(i + 1)
        theFlag = 1
    End If
    'letterNumberer1(sheet1)
    'letterNumberer2(sheet2)
Next i
Do flag = 0
    For i = 1 To lstPool.ListCount - 1
        If UCase(lstPool.List(i, 0)) < UCase(lstPool.List(i - 1, 0)) Then
            temp = lstPool.List(i, 0)
            lstPool.List(i, 0) = lstPool.List(i - 1, 0)
            lstPool.List(i - 1, 0) = temp
            flag = 1
        End If
    Next i
Loop Until flag = 0
End Sub

---

Hi Daxton,
I think the problem is the extent of the loop.

Code:

---

For i = 1 To (Sheets.Count - 1)  '<-- here
    sheet1 = UCase(Sheets(i).Name)
    sheet2 = UCase(Sheets(i + 1).Name)
    If sheet1 < sheet2 Then
        Sheets(i).Move after:=Sheets(i + 1)
        theFlag = 1
    End If
    'letterNumberer1(sheet1)
    'letterNumberer2(sheet2)
    Next i

---

:)

Tommy

It works, I wanna say thank you but it only does it once. Say i have 15 sheets then i have to press the button 15 times. How do I make the loop so that It goes thru all the sheets so that I only have to push the button once.

Then we need a bubble sort routine :)

Don't forget to dim J as Integer

Code:

---

For i = 1 To (Sheets.Count - 1)
    For j = i + 1 To Sheets.Count
        sheet1 = UCase(Sheets(i).Name)
        sheet2 = UCase(Sheets(j).Name)
        If sheet1 > sheet2 Then
            Sheets(i).Move after:=Sheets(j)
            theFlag = 1
        End If
    Next
    Next

---

That works better than that other one but i still have to push it several times before it works. I put a copy of it in here if you need it.

Ok I have a grip on it. What the problem is is the sheets get moved and the index changes, but I am still working on the old index number. this is just a heads up I need a little time to work it out. :)

Take all the time you want b/c u r helping me out.

Hey tommy I took that phonebook out of my msg. So just email me the new one if you get it fixed are if ya need another copy of it for whatever reason just let me know.

I rewrote your sub. I have an explaination in the code, if you have any questions do not hesitate to ask :)

Code:

---

Private Sub cmdPoolThem_Click()
    Dim i As Integer
    Dim j As Integer
    Dim Arr() As String  '<-- setup an array to store the sheet names
    Dim hldStr As String
    ReDim Arr(Sheets.Count)
    For i = 1 To Sheets.Count
    Arr(i) = UCase(Sheets(i).Name)  '<-- get the sheet names
    Next
    For i = 1 To Sheets.Count          '<-- bubble sort to sort the names
    For j = 1 To Sheets.Count
        If Arr(i) < Arr(j) Then        '<-- < largest to smallest > smallest to largest
            hldStr = Arr(i)
            Arr(i) = Arr(j)
            Arr(j) = hldStr
        End If
    Next
    Next
    '** put the first sorted sheet first
    If Sheets(1).Name <> Arr(1) Then Sheets(Arr(1)).Move before:=Sheets(1)
'***arrange the rest in order
For i = 2 To Sheets.Count
    Sheets(Arr(i)).Move after:=Sheets(i - 1)
Next
End Sub

---

Happy coding :type

Daxton,

Here is simplified code to sort the sheet names. Which I think you are looking for.

Code:

---

Sub Sort2()
    Dim fDone As Boolean
    Dim i As Integer
fDone = False
    While (Not fDone)
    fDone = True
    For i = 2 To Sheets.Count
        If UCase(Sheets(i - 1).Name) > UCase(Sheets(i).Name) Then
            Sheets(i).Move before:=Sheets(i - 1)
            fDone = False
        End If
    Next
    Wend
End Sub

---

Hey Daxton, did these codes work for you?

I looked at it and figured out that I can just use the sub for sorting the sheets that I already have in there. LOL. This question was before i knew that once a workbook is sorted and saved, u can't go back to the way it was before. Like the way they were b4 the order of the worksheets changed. Once that was told to me, I just used the Module that I already had written. But Thank You, All of you that responded.

Here's my code to see if I have anything that could be changed.

Code:

---

Sub SortSheetsAscending()
' Macro1 Macro
' Macro recorded 1/9/03 by Daxton Allen
Dim theFlag As Integer
Dim sheet1 As String
Dim Sheet2 As String
Dim i As Integer
Dim current As String
current = ActiveSheet.Name
Sheets(1).Activate
Do
    theFlag = 0
    For i = 1 To (Sheets.Count - 1)
        sheet1 = UCase(Sheets(i).Name)
        Sheet2 = UCase(Sheets(i + 1).Name)
        If sheet1 > Sheet2 Then
            Sheets(Sheet2).Move Before:=Sheets(sheet1)
            theFlag = 1
        End If
    Next I
Loop Until theFlag = 0
Sheets(current).Activate
End Sub
 
Sub SortSheetsDescending()
' Macro recorded 1/9/03 by Daxton Allen
Dim theFlag As Integer
Dim sheet1 As String
Dim Sheet2 As String
Dim i As Integer
Dim current As String
current = ActiveSheet.Name
Sheets(1).Activate
Do
    theFlag = 0
    For i = 1 To (Sheets.Count - 1)
        sheet1 = UCase(Sheets(i).Name)
        Sheet2 = UCase(Sheets(i + 1).Name)
        If sheet1 < Sheet2 Then
            Sheets(Sheet2).Move Before:=Sheets(sheet1)
            theFlag = 1
        End If
    Next i
Loop Until theFlag = 0
Sheets(current).Activate
End Sub

---