Lookup Code

[HAlssaqaf]

Hello All,

I'm wondering if anyone can help me out with the code below. When i
run it it takes very very long time to run. i would appreicate your
help. The data size is very large with multiple sheets but same
workbook (more than 50k rows and over 24 clos.)


'***Declarations
Dim iRowPlan As Integer
Dim iRowLTable As Integer
Dim iLastRowPlan As Integer
Dim iLastRowTable As Integer



' Select the lookup table (LTABLE)Worksheet
Sub Vlkup()
Sheets("LTABLE").Select

iLastRowTable = Cells.Find("*", , xlFormulas, , xlRows,
xlPrevious).Row

' Select the worksheet containing the Plan(PLAN)
Sheets("PLAN").Select
' Find the number of Planrecords and store it in iLastRow
iLastRowPlan = Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row



' Loop through the Plantable and compare each record with Plan in the
lookup table
' If a match is found, change the Plantable with what is in the lookup
table
For iRowPlan = 6 To iLastRowPlan
For iRowLTable = 2 To iLastRowTable
If Sheets("PLAN").Cells(iRowPlan, 1) =
Sheets("LTABLE").Cells(iRowLTable, 1) _
Then
Sheets("EssPlan").Cells(iRowPlan, 1) =
Sheets("LTABLE").Cells(iRowPlan, 2)
Sheets("EssPlan").Cells(iRowPlan, 2) =
Sheets("LTABLE").Cells(iRowLTable, 3)
Sheets("EssPlan").Cells(iRowPlan, 3) =
Sheets("LTABLE").Cells(iRowLTable, 4)
Sheets("EssPlan").Cells(iRowPlan, 4) =
Sheets("LTABLE").Cells(iRowLTable, 5)
Sheets("EssPlan").Cells(iRowPlan, 5) =
Sheets("LTABLE").Cells(iRowLTable, 6)
Sheets("EssPlan").Cells(iRowPlan, 6) =
Sheets("LTABLE").Cells(iRowLTable, 7)
Sheets("EssPlan").Cells(iRowPlan, 7) =
Sheets("LTABLE").Cell(iRowLTable, 8)
Sheets("EssPlan").Cells(iRowPlan, 8) =
Sheets("Plan").Cells(iRowPlan, 11)
Sheets("EssPlan").Cells(iRowPlan, 9) =
Sheets("Plan").Cells(iRowPlan, 12)
Sheets("EssPlan").Cells(iRowPlan, 10) =
Sheets("Plan").Cells(iRowPlan, 13)
Sheets("EssPlan").Cells(iRowPlan, 11) =
Sheets("Plan").Cells(iRowPlan, 14)
Sheets("EssPlan").Cells(iRowPlan, 12) =
Sheets("Plan").Cells(iRowPlan, 15)
Sheets("EssPlan").Cells(iRowPlan, 13) =
Sheets("Plan").Cells(iRowPlan, 16)
Sheets("EssPlan").Cells(iRowPlan, 14) =
Sheets("Plan").Cells(iRowPlan, 12)
Sheets("EssPlan").Cells(iRowPlan, 15) =
Sheets("Plan").Cells(iRowPlan, 13)
Sheets("EssPlan").Cells(iRowPlan, 16) =
Sheets("Plan").Cells(iRowPlan, 14)
Sheets("EssPlan").Cells(iRowPlan, 17) =
Sheets("Plan").Cells(iRowPlan, 15)
Sheets("EssPlan").Cells(iRowPlan, 18) =
Sheets("Plan").Cells(iRowPlan, 16)
Sheets("EssPlan").Cells(iRowPlan, 19) =
Sheets("Plan").Cells(iRowPlan, 17)
Sheets("EssPlan").Cells(iRowPlan, 20) =
Sheets("Plan").Cells(iRowPlan, 18)
Sheets("EssPlan").Cells(iRowPlan, 21) =
Sheets("Plan").Cells(iRowPlan, 19)
Sheets("EssPlan").Cells(iRowPlan, 23) =
Sheets("Plan").Cells(iRowPlan, 20)
Sheets("EssPlan").Cells(iRowPlan, 24) =
Sheets("Plan").Cells(iRowPlan, 21)
Exit For
End If
Next iRowLTable
Next iRowPlan
End Sub

 

[rleavitt]

Try a binary search. I use this a lot and it is much quicker than
spinning through each record. If you have fewer than 32768 records
then you do not need to start with such a big array. You should use an
array size that is a power of 2. (for example 2^14)

Warning: You first have to sort the rows in the "LTable" sheet by the
table index, for this to work right. It is very fast.

Const ArrayMax = 65526

' First load the TableKeys into an array

Dim TableKey(ArrayMax) as integer
For i = 2 to iLastRowTable
TableKey(i-1) = sheets("Ltable").cells(i,1)
Next i

' Now spin through the plan table

for i = 6 to iLastRowPlan
PlanKey = sheets("plan").cells(i,1)

' Binary search

Index = ArrayMax / 2
Delta = index / 2
found = false

while not found and delta >= 1
if index > iLastRowTable or PlanKey < TableKey(index) then
index = index - delta
elseif PlanKey > TableKey(index) then
index = index + delta
else
found = true
endif
delta = delta / 2
wend

' fill entries if you found the key

if plankey = tablekey(index) then
for col = 2 to 21
col2 = col
if col > 8 then col2 = col+ 2
sheets("Plan").cells(i,col2) = sheets("Ltable").cells(index+1,col)
next col
endif

next i

I hope this helps,
Rick