PDA

View Full Version : Solved: Putting the worksheets in order...



Daxton A.
06-28-2004, 12:03 PM
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

Tommy
06-28-2004, 03:40 PM
Hi Daxton,
I think the problem is the extent of the loop.
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

Daxton A.
06-29-2004, 07:18 AM
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.

Tommy
06-29-2004, 07:44 AM
Then we need a bubble sort routine :)

Don't forget to dim J as Integer


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

Daxton A.
06-29-2004, 08:09 AM
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.

Tommy
06-29-2004, 09:21 AM
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. :)

Daxton A.
06-29-2004, 09:25 AM
Take all the time you want b/c u r helping me out.

Daxton A.
06-29-2004, 09:29 AM
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.

Tommy
06-29-2004, 12:40 PM
I rewrote your sub. I have an explaination in the code, if you have any questions do not hesitate to ask :)

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

xXLdev
06-29-2004, 07:39 PM
Daxton,

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

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

Zack Barresse
07-08-2004, 10:34 AM
Hey Daxton, did these codes work for you?

Daxton A.
07-08-2004, 10:55 AM
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.
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()
'
' 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