Sort Sheets

  • Thread starter Thread starter Richard
  • Start date Start date
R

Richard

Hi,

I have a fairly large workbook, with 3 sets/groups of sheet name.
1) Cal yy, (where yy = the year)
2) mmm yy (mmm = month, yy = year)
3) Qn yy (n = 1/2/3/4, yy = year)

and an input sheet.

The code currently creates each sheet as required. I would like to be able
to sort them in their groups. Is it possible to sort the sheets in the order
the sheet name appears in a specific column, so that as each sheet is created
the new sheet name is added to the bottom of the list and a unique sort order
list is created for the code to refer to.
If that is not the best method please advise. If that sounds ok, please
advise.

Thanks in advance for your help

Richard
 
Hi Richard

Maybe this will help you:

Set newSh = ActiveWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
newSh.Name = "SheetName"

Regards,
Per
 
Per,

That to me reads as though the new sheet will always be added as the last
sheet. That isn't what I require. I need them to be sorted in what is a
chronological order within their own group ie Month, Q and Cal
 
This is a very unique sort problem. it requires 3 seperate sorts. first you
need to sort the sheets that start with Cal. then you need to ignore the
shetts that start wit a Q to get the months. You have the problem that you
can't just sort the sheets with the date name because Jan 02 get converted to
Jan 2 08. So you have to convert Jan 01 to Jan 1 02 and then sort. Finally
you have to sort the sheets starting with Q.

I used a bubble sort which finds the sheet that needs to be movedand then
puts it at the end of the previous sorted sheets. See code below.


Sub SortSheets()

SortSheet = 1
'Sort Cal Sheets
Do
FirstShtName = ""
For ShtCount = SortSheet To Sheets.Count
ShtName = Sheets(ShtCount).Name
If UCase(Left(ShtName, 3)) = "CAL" Then
If FirstShtName = "" Then
FirstShtName = ShtName
Else
If ShtName < FirstShtName Then
FirstShtName = ShtName
End If
End If
End If
Next ShtCount
If FirstShtName <> "" Then
If Sheets(SortSheet).Name <> FirstShtName Then
Sheets(FirstShtName).Move before:=Sheets(SortSheet)
End If
SortSheet = SortSheet + 1
If SortSheet = Sheets.Count Then
Exit Do
End If
End If
Loop While FirstShtName <> ""
'now sort months
Do
FirstShtName = ""
For ShtCount = SortSheet To Sheets.Count
ShtName = Sheets(ShtCount).Name
'convert to serial data
'make date 1st of the month

If UCase(Left(ShtName, 1)) <> "Q" Then
ShtDate = DateValue(Left(ShtName, 3) & _
" 1 " & Right(ShtName, 2))
If FirstShtName = "" Then
FirstShtName = ShtName
FirstSheetDate = ShtDate
Else
If ShtDate < FirstSheetDate Then
FirstShtName = ShtName
FirstSheetDate = ShtDate
End If
End If
End If
Next ShtCount
If FirstShtName <> "" Then
If Sheets(SortSheet).Name <> FirstShtName Then
Sheets(FirstShtName).Move before:=Sheets(SortSheet)
End If
SortSheet = SortSheet + 1
If SortSheet = Sheets.Count Then
Exit Do
End If
End If
Loop While FirstShtName <> ""
'Now sort Quarters
Do
FirstShtName = ""
For ShtCount = SortSheet To Sheets.Count
ShtName = Sheets(ShtCount).Name
ShtYear = Right(ShtName, 2)
ShtQuarter = Mid(ShtName, 2, 1)

If FirstShtName = "" Then
FirstShtName = ShtName
FirstSheetYear = ShtYear
FirstSheetQuarter = ShtQuarter
Else
If ShtYear < FirstSheetYear And _
ShtQuarter < FirstSheetQuarter Then
FirstShtName = ShtName
FirstSheetYear = ShtYear
FirstSheetQuarter = ShtQuarter
End If
End If
Next ShtCount
If FirstShtName <> "" Then
If Sheets(SortSheet).Name <> FirstShtName Then
Sheets(FirstShtName).Move before:=Sheets(SortSheet)
End If
SortSheet = SortSheet + 1
If SortSheet = Sheets.Count Then
Exit Do
End If
End If
Loop While FirstShtName <> ""

End Sub
 
The original code I posted could leave two sheets in the wrong place. I
didn't test these modifications but they should fix the problem.

Sub SortSheets()

SortSheet = 1
'Sort Cal Sheets
Do
FirstShtName = ""
For ShtCount = SortSheet To Sheets.Count
ShtName = Sheets(ShtCount).Name
If UCase(Left(ShtName, 3)) = "CAL" Then
If FirstShtName = "" Then
FirstShtName = ShtName
Else
If ShtName < FirstShtName Then
FirstShtName = ShtName
End If
End If
End If
Next ShtCount
If FirstShtName <> "" Then
If Sheets(SortSheet).Name <> FirstShtName Then
Sheets(FirstShtName).Move before:=Sheets(SortSheet)
End If
SortSheet = SortSheet + 1
If SortSheet >= Sheets.Count Then
Exit Do
End If
SortSheet = SortSheet + 1
End If
Loop While FirstShtName <> ""
'now sort months
Do
FirstShtName = ""
For ShtCount = SortSheet To Sheets.Count
ShtName = Sheets(ShtCount).Name
'convert to serial data
'make date 1st of the month

If UCase(Left(ShtName, 1)) <> "Q" Then
ShtDate = DateValue(Left(ShtName, 3) & _
" 1 " & Right(ShtName, 2))
If FirstShtName = "" Then
FirstShtName = ShtName
FirstSheetDate = ShtDate
Else
If ShtDate < FirstSheetDate Then
FirstShtName = ShtName
FirstSheetDate = ShtDate
End If
End If
End If
Next ShtCount
If FirstShtName <> "" Then
If Sheets(SortSheet).Name <> FirstShtName Then
Sheets(FirstShtName).Move before:=Sheets(SortSheet)
End If
If SortSheet >= Sheets.Count Then
Exit Do
End If
End If
SortSheet = SortSheet + 1
Loop While FirstShtName <> ""
'Now sort Quarters
Do
FirstShtName = ""
For ShtCount = SortSheet To Sheets.Count
ShtName = Sheets(ShtCount).Name
ShtYear = Right(ShtName, 2)
ShtQuarter = Mid(ShtName, 2, 1)

If FirstShtName = "" Then
FirstShtName = ShtName
FirstSheetYear = ShtYear
FirstSheetQuarter = ShtQuarter
Else
If ShtYear < FirstSheetYear And _
ShtQuarter < FirstSheetQuarter Then
FirstShtName = ShtName
FirstSheetYear = ShtYear
FirstSheetQuarter = ShtQuarter
End If
End If
Next ShtCount
If FirstShtName <> "" Then
If Sheets(SortSheet).Name <> FirstShtName Then
Sheets(FirstShtName).Move before:=Sheets(SortSheet)
End If
If SortSheet >= Sheets.Count Then
Exit Do
End If
End If
SortSheet = SortSheet + 1
Loop While FirstShtName <> ""

End Sub
 
Back
Top