re-order worksheets by sheet name

G

Guest

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
 
G

Guest

'=====================================================
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 - (e-mail address removed)
'
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 Before:=Worksheets(i)
End If
End If
If varAnswer = 2 Then
If UCase(Worksheets(x).name) > _
UCase(Worksheets(i).name) Then
Worksheets(x).Move Before:=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
'=====================================================
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top