The speed increase is chiefly down to a few main reasons:
1. Only one read from the sheet and only one write to the sheet
2. No repeated referring to the sheet during the macro
3. No formula calculation time because there are no formulae; the formulae added by the other code toward the bottom of your table refer to quite large ranges which often slows things down. All the calculation happens in the macro
blah itself and it's not really a calculation, just a comparison for equality amongst a few values for each row.
It's point number 3 that, in this case, is the most time consuming.
The first line:
LR = Cells(Rows.Rount,"B").end(xlup).row
puts a value into
LR being the row number of the last cell in column B with any data in.
It's the same as selecting cell B1048576, then pressing
End on the keyboard, then pressing the UP cursor key on the keyboard, and reading out what row the selection ends up at. (Lets say 131711, in your case)
The next line:
vals = Range("B1:C" & LR).Value
puts the values found in range B1:C131711 into an array:
I was lazy with the next line, I made a copy of the
vals array, so that
myResults array would have the correct vertical dimensions. This array will hold the results.
I should have instead written:
ReDim myResults(1 to UBound(vals),1 to 1)
The complete revised code is at the bottom of this message.
myResults(1, 1) = "Parent" just puts a header into the first slot (member) of the
myResults array. This will end up in cell A1.
The next section:
For rw = 2 To UBound(vals)
'some code
next rw
will loop, with
rw starting at 2 and adding 1 each time until it gets to 131711.
rw will be like a row number of the array, used like this:
vals(rw, 1)
equivalent to
vals(row number, column number)
So within this loop we ask whether
vals(rw,1) (
1 is the column of levels) is equal to 1, if so, because 1 is the highest level, there's no parent to look for, so we makes sure the result is blank (with my lazy assignment of
myResults we have to explicitly make it blank in order to overwrite what's already in there, but with my later
ReDim, all the members are already blank so there is nothing to do (that's why I ask instead that
vals(rw,1) <> 1 to avoid needing an
Else part).
So in the case of a level not being 1, we need to search the levels column, one row at a time
upwards, looking for the first occurence of a level which is one less that the level at row
rw. That's what the next mini-loop does:
myLevel = vals(rw, 1) - 1
is the level less
1 that we're looking for.
For upRw = rw - 1 To 2 Step -1
'some code
Next upRw
We start searching at
rw-1, the row above the current row we're examining, and will search right up to the 2nd row of the array if necessary.
upRw will decrement by 1 at each loop because of the
Step -1.
In the middle of this mini loop is:
If vals(upRw, 1) = myLevel Then
myResults(rw, 1) = vals(upRw, 2)
Exit For
End If
which asks 'does this row contain a level exactly 1 less than the level of the row I'm trying to find the parent of? If so then we've found the parent and we can update the
myResults array with its name. Crucially, for speed, if the parent has been found, we abandon this mini-loop with
Exit For, which takes the code to the line after
Next upRw. That line is
End If, and the one after that is
Next rw, that is the next row down in the list that needs its parent finding.
Once
rw reaches 131711, that loop terminates and we're left with an array in
myResults that need placing on the sheet.
With my lazy method,
myResults contains 2 columns but we're interested only in the first column, and certainly don't want to paste the second column anywhere at all. When we paste the array, it will only paste to the range we specify, so if we paste to only one column, the second column won't be pasted at all.
With the second method of initializing
myResults (
ReDim) there's only one column anyway.
All we need to do for this last line is to ensure the numbers of rows pasted is correct. That information is held in
LR still, so we use that:
Range("A1:A" & LR).Value = myResults
QED.
Revised code:
Code:
Sub blah2()
LR = Cells(Rows.Count, "B").End(xlUp).Row
vals = Range("B1:C" & LR).Value
ReDim myResults(1 To UBound(vals), 1 To 1)
myResults(1, 1) = "Parent" ' header
For rw = 2 To UBound(vals) 'starting at the top, run down the rows
If vals(rw, 1) <> 1 Then '1=top level already, no higher levels to search for.
'do a search up from that row:
myLevel = vals(rw, 1) - 1 'the level you're looking for.
For upRw = rw - 1 To 2 Step -1 'starting from the row above, look upwards for the first instance of myLevel
If vals(upRw, 1) = myLevel Then 'if TRUE then it's found
myResults(rw, 1) = vals(upRw, 2) 'add the contents of the adjacent cell
Exit For 'no need to keep looking further up, already found a match
End If
Next upRw
'this is where the code jumps to once Exit For is executed.
End If
Next rw 'next row down.
Range("A1:A" & LR).Value = myResults ' write the array to the sheet.
End Sub
