Writing the Sort procedure

It was time to sort the SheetNames array. One option was to insert the sorting code in the SortSheets procedure, but I thought a better approach was to write a general-purpose sorting procedure that I could reuse with other projects (sorting arrays is a common operation).

You might be a bit daunted by the thought of writing a sorting procedure. The good news is that it's relatively easy to find commonly used routines that you can use or adapt. The Internet, of course, is a great source for such information.

You can sort an array in many ways. I chose the bubble sort method; although it's not a particularly fast technique, it's easy to code. Blazing speed is not really a requirement in this particular application.

The bubble sort method uses a nested For-Next loop to evaluate each array element. If the array element is greater than the next element, the two elements swap positions. This evaluation is repeated for every pair of items (that is, n - 1 times).

CROSS- In Chapter 11, I present some other sorting routines and compare them in

REFERENCE terms of speed.

Here's the sorting procedure I developed (after consulting a few programming Web sites to get some ideas):

Sub BubbleSort(List() As String)

Dim First As Long, Last As Long Dim i As Long, j As Long Dim Temp As String First = LBound(List) Last = UBound(List) For i = First To Last - 1 For j = i + 1 To Last

If List(i) > List(j) Then Temp = List(j) List(j) = List(i) List(i) = Temp End If Next j Next i End Sub

This procedure accepts one argument: a one-dimensional array named List. An array passed to a procedure can be of any length. I used the LBound and UBound functions to define the lower bound and upper bound of the array to the variables First and Last, respectively.

Here's a little temporary procedure that I used to test the BubbleSort procedure:

Sub SortTester()

Call BubbleSort(x)

Debug.Print i, x(i) Next i End Sub

The SortTester routine creates an array of five strings, passes the array to BubbleSort, and then displays the sorted array in the Immediate window. I eventually deleted this code because it served its purpose.

After I was satisfied that this procedure worked reliably, I modified SortSheets by adding a call to the BubbleSort procedure, passing the SheetNames array as an argument. At this point, my module looked like this:

Sub SortSheets()

Dim SheetNames() As String Dim SheetCount as Long Dim i as Long

SheetCount = ActiveWorkbook.Sheets.Count ReDim SheetNames(1 To SheetCount) For i = 1 To SheetCount

SheetNames(i) = ActiveWorkbook.Sheets(i).Name Next i

Call BubbleSort(SheetNames) End Sub

Sub BubbleSort(List() As String) ' Sorts the List array in ascending order Dim First As Long, Last As Long Dim i As Long, j As Long Dim Temp As String First = LBound(List) Last = UBound(List) For i = First To Last - 1 For j = i + 1 To Last

If List(i) > List(j) Then Temp = List(j) List(j) = List(i) List(i) = Temp End If Next j Next i End Sub

When the SheetSort procedure ends, it contains an array that consists of the sorted sheet names in the active workbook. To verify this, you can display the array contents in the VBE Immediate window by adding the following code at the end of the SortSheets procedure (if the Immediate window is not visible, press Ctrl+G):

For i = 1 To SheetCount

Debug.Print SheetNames(i) Next i

So far, so good. Next step: Write some code to rearrange the sheets to correspond to the sorted items in the SheetNames array.

The code that I recorded earlier proved useful. Remember the instruction that was recorded when I moved a sheet to the first position in the workbook?

Sheets("Sheet3").Move Before:=Sheets(1)

After a little thought, I was able to write a For-Next loop that would go through each sheet and move it to its corresponding sheet location, specified in the SheetNames array:

For i = 1 To SheetCount

Sheets(SheetNames(i)).Move Before:=Sheets(i) Next i

For example, the first time through the loop, the loop counter i is 1. The first element in the SheetNames array is (in this example) Sheet1. Therefore, the expression for the Move method within the loop evaluates to

Sheets("Sheet1").Move Before:= Sheets(1)

The second time through the loop, the expression evaluates to

Sheets("Sheet2").Move Before:= Sheets(2)

I then added the new code to the SortSheets procedure:

Sub SortSheets()

Dim SheetNames() As String Dim SheetCount as Long Dim i as Long

SheetCount = ActiveWorkbook.Sheets.Count ReDim SheetNames(1 To SheetCount) For i = 1 To SheetCount

SheetNames(i) = ActiveWorkbook.Sheets(i).Name Next i

Call BubbleSort(SheetNames) For i = 1 To SheetCount

ActiveWorkbook.Sheets(SheetNames(i)).Move _ Before:=ActiveWorkbook.Sheets(i)

Next i End Sub

I did some testing, and it seemed to work just fine for the Test.xlsx workbook.

Time to clean things up. I made sure that all the variables used in the procedures were declared, and then I added a few comments and blank lines to make the code easier to read. The SortSheets procedure looked like the following:

Sub SortSheets ()

' This routine sorts the sheets of the

' active workbook in ascending order.

' Use Ctrl+Shift+S to execute

Dim SheetNames() As String Dim SheetCount As Long Dim i As Long

Determine the number of sheets & ReDim array SheetCount = ActiveWorkbook.Sheets.Count ReDim SheetNames(1 To SheetCount)

Fill array with sheet names For i = 1 To SheetCount

SheetNames(i) = ActiveWorkbook.Sheets(i).Name

Next i

' Sort the array in ascending order

Call BubbleSort(SheetNames) ' Move the sheets

For i = 1 To SheetCount

ActiveWorkbook.Sheets(SheetNames(i)).Move _ Before:= ActiveWorkbook.Sheets(i)

Next i End Sub

Everything seemed to be working. To test the code further, I added a few more sheets to Test.xlsx and changed some of the sheet names. It worked like a charm.

0 0

Post a comment