Update on Weave Merging n lists into single list

This is a follow up to my previous post from 7 months ago. I changed up the algorithm a little. Instead of inserting items into a new list, each item's final place is calculated up front. Sort of like if instead of resizing an array each time I add a new item, I'm sizing it up front and just setting the value of each element. If the place is already occupied, the closest open place is found. This avoids everything getting shifted around as new items are inserted into the list, so every item is as close as possible to it's ideal place in the new list.

```
Sub TrueShuffle()

' object declarations
Dim xl As Object ' Excel.Application
Dim wb As Object ' Excel.Workbook
Dim destinationWs As Object ' Excel.Worksheet
Dim sourceWs As Object ' Excel.Worksheet
Dim totalsWs As Object ' Excel.Worksheet

' variable declarations
Dim artistName As String
Dim quotient As Double
Dim quotientSum As Double
Dim timeElapsed As Double
Dim pivotRows As Integer
Dim songCount As Integer
Dim artist As Integer
Dim song As Integer
Dim artistSongs As Integer
Dim oldRow As Integer
Dim newRow As Integer
Dim adjustment As Integer
Dim first As Integer
Dim sign As Integer

' start timer and turn off screen updating
timeElapsed = Timer
Application.ScreenUpdating = False

' set xl objects
Set wb = ThisWorkbook
Set totalsWs = wb.Worksheets("Totals")
Set sourceWs = wb.Worksheets("Source")
Set destinationWs = wb.Worksheets("Dest")

' opening operations
songCount = sourceWs.Range("A1").End(xlDown).row - 1 ' total songs in destination sheet
totalsWs.PivotTables("SongCount").ChangePivotCache _
wb.PivotCaches.Create(SourceType:=xlDatabase _
, SourceData:="Source!A1:C" & songCount + 1) ' set pivot data source range
totalsWs.PivotTables("SongCount").RefreshTable ' refresh pivot table
pivotRows = totalsWs.Range("B1").End(xlDown).row

Error Handling (and avoidance)

First, I would either add error handling or replace code that can throw errors with code that can't. For example, on an empty Worksheet this line will throw an overflow error:

songCount = sourceWs.Range("A1").End(xlDown).row - 1    ' total songs in destination sheet

I would personally replace this with a call to .UsedRange:

songCount = sourceWs.UsedRange.Rows.Count

What an error handler will do is let you clean up anything in the environment that had already been changed back to a safe setting. I.e.

Application.ScreenUpdating = False

I generally use a template something like the following:

Option Explicit

Public Sub TrueShuffle()

    On Error GoTo ErrorHandler

    '... Code here ...

ErrorHandler:
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
    End If

    'Turn screen updating back on.
    Application.ScreenUpdating = True

End Sub

Note that I also explicitly declared the scope of the Sub as Public and set Option Explicit, both of which you should be in the habit of doing.

Needless to say, turning error handling off instead of avoiding errors is generally not the best strategy, especially with a while loop between turning it off and turning it back on:

On Error Resume Next

' find the closest empty space
adjustment = 1
sign = 1

Do While destinationWs.Range("A" & newRow).Value2 <> 0
    newRow = newRow + adjustment
    adjustment = (adjustment + sign) * (-1)
    sign = sign * (-1)
Loop

On Error GoTo 0

Let's assume for the sake of argument that the expression that throws the error is this (which is the most likely place you'll get a throw):

destinationWs.Range("A" & newRow).Value2

If the error is caused by newRow being out of bounds (for example 0 or negative), it's possible if not likely that you'll "Resume Next" in an infinite loop.

Other Notes

Remove unused variables:

Dim xl As Object ' Excel.Application is never even set.

Try to avoid declaring variables as "Object" unless you are using late binding or a COM object that doesn't have clean marshalling behavior - use the explicit type declarations:

Dim wb As Workbook, destinationWs As Worksheet, sourceWs As Worksheet
Dim totalsWs As Worksheet

When you declare them as "Object", you are using the IDispatch interface of the object instead of the IUnknown interface, and that carries a ton of overhead as compared to using the registered type definition. There's a really good explanation of the difference here.

Addressing cells with the alphanumeric addresses is really slow - column and row indexes are usually about twice as fast. Interestingly, the string concatenation isn't what slows it down (although it certainly doesn't help) - it's whatever Excel is doing to resolve the address:

Dim cell As Range
Set cell = ActiveSheet.Range("A" & 1)     '375 ms over 200000 calls.
Set cell = ActiveSheet.Range("A1")        '343 ms over 200000 calls.
Set cell = ActiveSheet.Cells(1, 1)        '156 ms over 200000 calls.

Using the Excel .Copy() function will destroy whatever the user has on the clipboard (rather poor form), and can also fail with a runtime error 1004 if another application happens to be reading or writing to it. Since the Ranges are the same size, you can simply assign the values from one to the other. If they aren't the same size, just resize the destination Range and do the same thing:

sourceWs.Range("A" & oldRow & ":C" & oldRow).Copy destinationWs.Range("A" & newRow & ":C" & newRow)
'...becomes...
destinationWs.Range("A" & newRow & ":C" & newRow).Value2 = sourceWs.Range("A" & oldRow & ":C" & oldRow).Value2

Select or switch structures traditionally have another level of indentation for the cases to make them easier to read...

Select Case artist
    Case 2
        '...
    Case Else
        '...
End Select

...although in this case, there is no reason to use a select with only 2 cases - If ... Else is much clearer:

If artist = 2 Then
    '...
Else
    '...
End If

Finally, you shouldn't keep row counters in Integer types. They are only 16 bit and an Excel sheet can have enough rows to overflow them.

Dim newRow As Integer    'Runtime error 6 waiting to happen.
Dim newRow As Long       'Much better.

Sorting Method

While the algorithm that you use looks solid, using it the way you are in Excel VBA completely disregards what Excel is good at - which is handling large amounts of data in tables. You are going to have a hard time finding a VBA routine that performs a sorting function better than the built-in sorts. What you are really after here is a way to provide your own sort criteria, so your focus should be solely on doing that. Pick an unused column, write sort criteria to it, and use it to sort the sheet - it's as simple as that. This is a quick sample as to how I would go about this (error handler omitted because this is already a mu

StackExchange Code Review Q#84899, answer score: 4