excel vba dictionary vlookup - excel

Question

My code need more than one hours to complete for 3500 rows but I need to work for more than 40000 rows data.
I am looking for alternatives to my code by using dictionary, with improved performance within the context of interest.
Could anyone help me?
Sub StripRow2Node()
'Read the Strip Design table
With Sheets("Design-Moment")
Sheets("Design-Moment").Activate
LastR1 = .Range("B" & Cells.Rows.Count).End(xlUp).Row
DM_arr = .Range(Cells(1, 1), Cells(LastR1, 7)) 'Col 1 to Col 7
DM_count = UBound(DM_arr, 1)
End With
'Read the x and y coordinations and thickness of a node in node design
With Sheets("Design-Shear")
Sheets("Design-Shear").Activate
LastR2 = .Range("B" & Cells.Rows.Count).End(xlUp).Row
DS_arr = .Range(Cells(1, 4), Cells(LastR2, 5)) 'Col 4 to Col 5
SX_arr = .Range(Cells(1, 26), Cells(LastR2, 27))
SY_arr = .Range(Cells(1, 30), Cells(LastR2, 31))
DS_count = UBound(DS_arr, 1)
End With
'** Find correponding reference row in Design-Moment for nodes**
'Match node to striip station and output row index
For i = 5 To DS_count
XStrip = SX_arr(i, 1)
XStation = DS_arr(i, 1)
YStrip = SY_arr(i, 1)
YStation = DS_arr(i, 2)
For j = 5 To DM_count
If DM_arr(j, 1) = XStrip Then 'X-Strip Name is matched
If DM_arr(j, 4) >= XStation And DM_arr(j - 1, 4) < XStation Then
SX_arr(i, 2) = j 'matched row reference for X-strip
End If
End If
If DM_arr(j, 1) = YStrip Then
If DM_arr(j, 5) <= YStation And DM_arr(j - 1, 5) > YStation Then
SY_arr(i, 2) = j
End If
End If
Next j
Next i
'Write the matched strip information to node
For i = 5 To LastR2
With Sheets("Design-Shear")
.Cells(i, 27) = SX_arr(i, 2)
.Cells(i, 31) = SY_arr(i, 2)
End With
Next i
End Sub

Answer 1

I suspect that almost all the time is being used writing back cell-by-cell to the sheet here:
'Write the matched strip information to node
For i = 5 To LastR2
With Sheets("Design-Shear")
.Cells(i, 27) = SX_arr(i, 2)
.Cells(i, 31) = SY_arr(i, 2)
End With
Next i
Writing back to Excel is much slower than reading from Excel.
I would suggest switching off screen updating and calculation, accumulating the results (currently X_arr(i, 2) and SY_arr(i, 2)) in separate arrays and then writing the arrays back to a range in a single operation rather than cell-by-cell

Answer 2

There are several points to improve:
1. Use qualified references to avoid.activate statements
You start off nicely with
With Sheets("Design-Shear")
...
DS_arr = .Range(Cells(1, 4), Cells(LastR2, 5)) 'Col 4 to Col 5
but fail to make the Cells objects refer to the With block. Instead use
With Sheets("Design-Shear")
...
DS_arr = .Range(.Cells(1, 4), .Cells(LastR2, 5)) 'Col 4 to Col 5
Now you do not have to activate the sheet anymore.
From the code I have to assume that there is only one possible match returned in this statement:
SX_arr(i, 2) = j
for all i; otherwise, the second, third...occurrence would overwrite this value of j. If that is indeed the case you can stop looping over j once a match is found:
SX_arr(i, 2) = j 'matched row reference for X-strip
Exit For
Shortcut both If statements if DM_arr(j, 1) can match XStrip or YStrip. If these matches are mutually exclusive, use ElseIf instead of If for the second statement.
Shortcutting the j-loop should improve the runtime noticeably. Of course, if you need the last matching index (instead of the first) then this will not apply.
edit:
For a dictionary solution, see for instance the excellent code from Jeeped here: https://codereview.stackexchange.com/questions/133664/searching-values-of-range-x-in-range-y