View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Gary Brown[_5_] Gary Brown[_5_] is offline
external usenet poster
 
Posts: 236
Default re-order worksheets by sheet name

'================================================= ====
Sub WorksheetSort()
'sort worksheets in a workbook
' 07/02/2000 - included hidden sheets in sort and return to
' sheet that was active at start of sort
' 10/24/2000 - added GetChoices form per J.Walkenbach
' This procedure used function GETCHOICES in Mod_ChoicesForm
' written by Gary L. Brown -
'
On Error GoTo err_WorksheetSort
Dim aryHiddensheets, aryChoices(1 To 2)
Dim i As Integer, x As Integer, iWksheetCount As Integer
Dim iWorksheets As Integer, y As Integer
Dim strWorksheetName As String
Dim varAnswer As Variant

'----------Set up Choices----------------
aryChoices(1) = "Ascending"
aryChoices(2) = "Descending"
'----------------------------------------

'get choice (call GetChoice function - Mod_ChoicesForm)
varAnswer = GetChoice(aryChoices, 1, "Worksheet Sort...")

If varAnswer = False Then
MsgBox "Worksheet sort has been canceled....", _
vbExclamation, "WARNING..."
Exit Sub
End If

'Count number of worksheets in workbook and get sheet name
iWorksheets = ActiveWorkbook.Sheets.Count
strWorksheetName = Application.ActiveSheet.name

'redim array
ReDim aryHiddensheets(1 To iWorksheets)

'put hidden sheets in an array, then unhide the sheets
For x = 1 To iWorksheets
If Worksheets(x).Visible = False Then
aryHiddensheets(x) = Worksheets(x).name
Worksheets(x).Visible = True
End If
Next

iWksheetCount = Application.ActiveWorkbook.Worksheets.Count

For i = 1 To iWksheetCount
For x = i To iWksheetCount
If varAnswer = 1 Then
If UCase(Worksheets(x).name) < _
UCase(Worksheets(i).name) Then
Worksheets(x).Move Befo=Worksheets(i)
End If
End If
If varAnswer = 2 Then
If UCase(Worksheets(x).name) _
UCase(Worksheets(i).name) Then
Worksheets(x).Move Befo=Worksheets(i)
End If
End If
Next x
Next i

HideAndExit:
're-hide previously hidden sheets
On Error Resume Next
y = UBound(aryHiddensheets)
For x = 1 To y
Worksheets(aryHiddensheets(x)).Visible = False
Next

Application.Worksheets(strWorksheetName).Activate

exit_WorksheetSort:
Exit Sub

err_WorksheetSort:
MsgBox "Error: " & Err & " - " & Err.Description
Resume exit_WorksheetSort

End Sub
'================================================= ====


"Julia Chromicz" wrote:

I often need to organize worksheets in a workbook left to right,
alphabetically by sheet name. Is there a way to automate this process?

As an added bonus, it would also be helpful if I could organize only
selected sheets alphabetically.

Thanks!
Julia