Alternatives to "WorksheetFunction.VLookup"

D

Damien McBain

Hi

I have a sub which uses a For...Next loop to populate the cells in a
column.based on the contents of column A in the same row.

I presently use WorksheetFunction.VLookup to get the value from another
worksheet. Is there a faster way to achieve the same result, maybe without
calling a worksheet function? The code takes some time to run through about
400 cells. I have auto calculation turned off during execution.

TIA

Damien
 
J

Joel

Try this code. Instead of Range you can also use Rows or columns.
Set searchrange = Range("A1:D7")
or
Set searchrange = Columns("A:A")
or
Set searchrange = Rows(5)



Set searchrange = Range("A1:D7")
searchstring = "mystring"
Set c = searchrange.Find(what:=searchstring, LookIn:=xlValues)
If Not c Is Nothing Then
lookupdata = c.Offset(0, 3)
End If
 
B

Barb Reinhardt

Another alternate would be to define a range of the cells you are using for
the for/next and do something like this

Dim myRange as range
Set myRange = Range("B2:B400")
myRange.FormulaR1C1 = "=vlookup(..."

'Calculate the sheet
myRange.parent.calculate
'If you want the values, instead of the function
myRange.value = myrange.value
 
D

Damien McBain

Thanks Barb.

I tried that originally, it also took a long time to run because (and I
failed to mention this originally) there are a number of different tables
containing the lookup data and the user tells the code which table to look
in (and what to look for) using a value in column B (with Select Case). This
means I need to evaluate each cell one after the other and can't operate on
the range all at once unfortunately.

Here's the code as it is now (fwiw) - as you can see I'm not much of a
programmer!:
======================
Sub GetWeek1Data()
Application.Calculation = xlCalculationManual

On Error Resume Next

Dim LookupRange
Dim LookupValue
Dim ImportInd
Dim SumRange
Dim BR1Rev, Br2Rev, Br3Rev, Br4Rev, Br5Rev

For Each C In Range("E4:E500")

ImportInd = ActiveSheet.Cells(C.Row, 2).Value

Select Case ImportInd

Case Is = ""

Case Is = "M"

Case Is = "A"

LookupValue = ActiveSheet.Cells(C.Row, 1).Value
LookupRange = Range("Week1")
C.Value = Application.WorksheetFunction.VLookup(LookupValue,
LookupRange, 4, False)

Case Is = "R"

LookupValue = CStr(Range("Branch1").Value &
Left(ActiveSheet.Cells(C.Row, 1).Value, 6) & ActiveSheet.Cells(2,
C.Column).Value)
LookupRange = Range("REVTABLE")
BR1Rev = Application.WorksheetFunction.VLookup(LookupValue,
LookupRange, 5, False) * -1

If Range("Branch2").Value = "" Then
GoTo cont
Else
LookupValue = CStr(Range("Branch2").Value &
Left(ActiveSheet.Cells(C.Row, 1).Value, 6) & ActiveSheet.Cells(2,
C.Column).Value)
LookupRange = Range("REVTABLE")
Br2Rev = Application.WorksheetFunction.VLookup(LookupValue,
LookupRange, 5, False) * -1
End If

If Range("Branch3").Value = "" Then
GoTo cont
Else
LookupValue = CStr(Range("Branch3").Value &
Left(ActiveSheet.Cells(C.Row, 1).Value, 6) & ActiveSheet.Cells(2,
C.Column).Value)
LookupRange = Range("REVTABLE")
Br3Rev = Application.WorksheetFunction.VLookup(LookupValue,
LookupRange, 5, False) * -1
End If

If Range("Branch4").Value = "" Then
GoTo cont
Else
LookupValue = CStr(Range("Branch4").Value &
Left(ActiveSheet.Cells(C.Row, 1).Value, 6) & ActiveSheet.Cells(2,
C.Column).Value)
LookupRange = Range("REVTABLE")
Br4Rev = Application.WorksheetFunction.VLookup(LookupValue,
LookupRange, 5, False) * -1
End If

If Range("Branch5").Value = "" Then
GoTo cont
Else
LookupValue = CStr(Range("Branch5").Value &
Left(ActiveSheet.Cells(C.Row, 1).Value, 6) & ActiveSheet.Cells(2,
C.Column).Value)
LookupRange = Range("REVTABLE")
Br5Rev = Application.WorksheetFunction.VLookup(LookupValue,
LookupRange, 5, False) * -1
End If

cont:
C.Value = BR1Rev + Br2Rev + Br3Rev + Br4Rev + Br5Rev

BR1Rev = Nothing
Br2Rev = Nothing
Br3Rev = Nothing
Br4Rev = Nothing
Br5Rev = Nothing


Case Is = "P"

C.Value = Cells(C.Row, 3).Value

Case Is = "E"
' "E" is used at the end of the list to stop the for..next

Application.Calculate
Application.Calculation = xlCalculationAutomatic

Exit Sub

Case Else

End Select

Next C

End Sub
====================
cheers

Damien
 
J

Joel

You r code is probably running slow becaue you are reusing the variable C in
two different cases

first here
For Each c In ActiveSheet.Range("E4:E500")

and then again

C.Value = Application.WorksheetFunction.VLookup(LookupValue,
LookupRange, 4, False)


Inside a "for each" loop you can't change the value of the index (in this
case C).
 
B

Bob Phillips

Nonsense, c is a range and he is picking up the range object and setting its
value property, that is legitimate.

Damien,

Not sure how much difference, but this might be somewhat faster. On
specifics, should you be setting it back to Automatic calculation on a value
of E, it will stay auto thereafter. I would have thought you do that after
all cells are processed.


Sub GetWeek1Data()
Dim c As Range
Dim LookupRange As Range
Dim LookupValue
Dim LookupRevTable As Range
Dim ImportInd
Dim BR1Rev As Double
Dim Br2Rev As Double
Dim Br3Rev As Double
Dim Br4Rev As Double
Dim Br5Rev As Double

Application.Calculation = xlCalculationManual

On Error Resume Next

With ActiveSheet

Set LookupRevTable = .Range("REVTABLE")

For Each c In Range("E4:E500")

ImportInd = .Cells(c.Row, 2).Value

Select Case ImportInd

Case Is = "A"

LookupValue = .Cells(c.Row, 1).Value
LookupRange = .Range("Week1")
c.Value = Application.VLookup(LookupValue,
LookupRange, 4, False)

Case Is = "R"

LookupValue = CStr(.Range("Branch1").Value & _
Left(.Cells(c.Row, 1).Value, 6) & _
.Cells(2, c.Column).Value)
BR1Rev = Application.VLookup(LookupValue,
LookupRevTable, 5, False) * -1

If Range("Branch2").Value = "" Then
GoTo cont
Else
LookupValue = CStr(.Range("Branch2").Value & _
Left(.Cells(c.Row, 1).Value, 6) & _
.Cells(2, c.Column).Value)
Br2Rev = Application.VLookup(LookupValue,
LookupRevTable, 5, False) * -1
End If

If Range("Branch3").Value = "" Then
GoTo cont
Else
LookupValue = CStr(.Range("Branch3").Value & _
Left(.Cells(c.Row, 1).Value, 6) & _
.Cells(2, c.Column).Value)
Br3Rev = Application.VLookup(LookupValue,
LookupRevTable, 5, False) * -1
End If

If Range("Branch4").Value = "" Then
GoTo cont
Else
LookupValue = CStr(.Range("Branch4").Value & _
Left(.Cells(c.Row, 1).Value, 6) & _
.Cells(2, c.Column).Value)
Br4Rev = Application.VLookup(LookupValue,
LookupRevTable, 5, False) * -1
End If

If Range("Branch5").Value = "" Then
GoTo cont
Else
LookupValue = CStr(.Range("Branch5").Value & _
Left(.Cells(c.Row, 1).Value, 6) & _
.Cells(2, c.Column).Value)
Br5Rev = Application.VLookup(LookupValue,
LookupRevTable, 5, False) * -1
End If

cont:
c.Value = BR1Rev + Br2Rev + Br3Rev + Br4Rev + Br5Rev

BR1Rev = 0: Br2Rev = 0: Br3Rev = 0: Br4Rev = 0: Br5Rev
= 0
Case Is = "P"

c.Value = .Cells(c.Row, 3).Value

Case Is = "E"
' "E" is used at the end of the list to stop the
for..next

Application.Calculate
Application.Calculation = xlCalculationAutomatic

Exit Sub
Case Else

End Select
Next c
End With

End Sub



--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
R

Rick Rothstein \(MVP - VB\)

Using your code structure (not the OP's), I believe the entire Case Is = "R"
block can be simplified like this...

Delete the five Dim statements for BR1Rev, BR2Rev, BR3Rev, BR4Rev, BR5Rev
and add these two Dim statements instead...

Dim X As Long
Dim BrRevs(1 To 5) As Double

Then delete everything in your Case Is = "R" block and replace it with
this...

X = 1
Do
LookupValue = CStr(.Range("Branch" & X).Value & _
Left(.Cells(C.Row, 1).Value, 6) & _
.Cells(2, C.Column).Value)
BrRevs(X) = -1 * Application.VLookup(LookupValue, _
LookupRevTable, 5, False)
X = X + 1
Loop While Range("Branch" & X).Value <> ""
C.Value = BrRevs(1) + BrRevs(2) + BrRevs(3) + BrRevs(4) + BrRevs(5)
Erase BrRevs

Now, I did not test this all out; but, on paper, it looks like it should
function exactly like your version of the Case Is = "R" code block.

Rick
 
D

Damien McBain

Thanks Bob,

E is the last entry in the list (column B). The number of rows can vary so I
put the E there to stop the code going all the way down to row 500 if it's
not necessary.

Thanks for your code suggestion. I had to change some of the ranges because
..Range("Week1") and .Range("Branch1") are on different worksheets (not the
active sheet). I also had to append "Set" before "LookupRange = ..." becasue
it was generating a variable not set error.

The whole thing now runs in a fraction of the time it originally took. I
incorporated Rick's suggestion for Case Is = "R".

For some reason though (only where Case Is = "A"), the vlookup now returns
#N/A! when it can't find the lookupvalue (as it would using a worksheet
formula). It previously generated and error and caused the code to resume
next. I can't see how the changes to the declaration and setting of the
range variables could cause this to occur?
 
D

Damien McBain

Changing back to "Application.WorksheetFunction.Vlookup" fixed the #N/A
problem. I also tried:

Rslt = Application.VLookup(LookupValue, LookupRange, 4, False)
If Rslt <> "#N/A" Then
c.Value = Rslt
Else
End If

But that still returned #N/A
 
D

Dana DeLouis

Hi. Just some small ideas.

Your LookupRange is being reset to the same value each time. Perhaps set it
once before the loop.
In general...

Set LookupRevTable = .Range("REVTABLE")
Set LookupRange = .Range("Week1")

For Each c In Range("E4:E500")
Select Case ImportInd
Case "A"
' It's already set.

(I like to use Case "A", and not Case Is = "A")

I like Rich's idea. It appears to me that BranchX are constants, yet we
build strings to extract their value on each loop.
Perhaps get there values only once. Here's one of many ideas.

This is not tested, but I was thinking something along this line.

Earlier in code:

Branches = Array("", _
[Branch1].Value, _
[Branch2].Value, _
[Branch3].Value, _
[Branch4].Value, _
[Branch5].Value)


Then...

Case "R"
'// K1 & K2 are constants.
K1 = Left(.Cells(c.Row, 1).Value, 6)
K2 = .Cells(2, c.Column).Value

x = 1
Do
LookupValue = Branches(x) & K1 & K2
BrRevs(x) = -1 * Application.VLookup(LookupValue, _
LookupRevTable, 5, False)
x = x + 1
Loop While Branches(x) <> vbNullString
c.Value = WorksheetFunction.Sum(BrRevs)
Erase BrRevs
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top