Speed it up - a Benefit inherent in using the Cells Method

[xladept]

A recent thread has given me the idea for this tip. The problem was to piece back together a workbook that had been split in many worksheets because of column overflow. The OP, however, insisted that it could only be restored by matching the column and row headers. I eventually accepted that.

During testing the OP mentioned that the shortened sample was taking 15 minutes to run and then it gave unexpected results - well we resolved the results issue but I realized that I could speed up the processing significantly by having the matches and placements all take place in core.

I wrote, serendipitously, the first routine using the cells method:

Sub Consolidate2X(): Dim ws As Worksheet, wc As Worksheet 'T=48.25390625 vs 42.8984375

Dim i As Long, j As Long, q As Long, p As Long, T As Single
Dim k As Integer, r As Long, er As Long, c As Long, ec As Long
                          Set wc = Sheets("Combined")
c = wc.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
r = wc.Rows.Find("*", , , , xlByRows, xlPrevious).Row
 
                          T = Timer

For k = 1 To Worksheets.Count
                    If Worksheets(k).Name <> wc.Name Then
                            Set ws = Worksheets(k)
            er = ws.Rows.Find("*", , , , xlByRows, xlPrevious).Row
     ec = ws.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
       


 For q = 3 To ec
        p = 4: Do Until wc.Cells(1, p) = ws.Cells(1, q): p = p + 1
                If p > c Then GoTo GetAnother
                Loop
                      For i = 2 To er
        j = 2: Do Until wc.Cells(j, 2) = ws.Cells(i, 1): j = j + 1
                If j > r Then GoTo GetAnother
                Loop
                        wc.Cells(j, p) = ws.Cells(i, q)
        Next i
GetAnother: Next q:  End If: Next k: T = Timer - T: wc.Range("A" & r + 2) = T

End Sub

And the conversion to core processing was trivial - all I had to to was replace:

wc.Cells and ws.Cells with S and W respectively:

Sub Consolidate3X(): Dim S, W, ws As Worksheet, wc As Worksheet 'T=1.26953125

Dim i As Long, j As Long, q As Long, p As Long, T As Single
Dim k As Integer, r As Long, er As Long, c As Long, ec As Long
                  Set wc = Sheets("Combined")
c = wc.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
r = wc.Rows.Find("*", , , , xlByRows, xlPrevious).Row
 
        S = wc.Range(wc.Cells(1, 1), wc.Cells(r, c)): T = Timer
        
For k = 1 To Worksheets.Count
                    If Worksheets(k).Name <> wc.Name Then
                            Set ws = Worksheets(k)
         er = ws.Rows.Find("*", , , , xlByRows, xlPrevious).Row
   ec = ws.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
        
        W = ws.Range(ws.Cells(1, 1), ws.Cells(er, ec))
        
                         For q = 3 To ec
        p = 4: Do Until S(1, p) = W(1, q): p = p + 1
                If p > c Then GoTo GetAnother
                Loop
                       For i = 2 To er
        j = 2: Do Until S(j, 2) = W(i, 1): j = j + 1
                If j > r Then GoTo GetAnother
                Loop
                        S(j, p) = W(i, q)
        Next i
GetAnother: Next q:  End If: Next k: T = Timer - T: wc.Range("A" & r + 2) = T
        wc.Range(wc.Cells(1, 1), wc.Cells(r, c)) = S
End Sub

And, should you like to try the code, the Demo File:RCMatchDemo.xlsm

Running the 2X routine plain took 48.25390625 timer units vs 42.8984375 timer units without screen updating
Running the 3X routine took 1.26953125 timer units - whatever they are (seconds???)
This is the thread