Hello there!

In looking for fastening up our vlookups I found the friendly fastexcel people. Therefore I am trying to get the fastexcel flookup to work so that people can easily execute it.

For this I am trying to build a sub flookup() to call the function. However, I'm still learning vba and I can't get it to work towards flexible usage. Would very much appreciate any help!

Thanks a bunch in any case!

Option Explicit
Option Base 1
Option Compare Text
'
' COPYRIGHT © DECISION MODELS LIMITED 2006, 2007, 2011. All rights reserved
' May be redistributed for free but
' may not be sold without the author's explicit permission.
'

''''' my sub
Sub flookupmsg()
Dim Lookup_value As Variant
Dim Lookup_Range As Range
Dim Answer_ColNum As Variant
Dim Sort_Type As Variant
Dim Exact_Match As Variant

Lookup_value = InputBox("lookup value", "value")
Lookup_Range = InputBox("lookup range", Type:=8)
Answer_ColNum = InputBox("which column?", "columnnumber")
Sort_Type = InputBox("-1 = sorted descending ,1 = sorted ascending,0 = not sorted", "column type optional")
Exact_Match = InputBox("Exact_Match may be: True or False or any Non-Boolean value or string", "exact match")

ActiveSheet = flookup(Lookup_value, Lookup_Range, Answer_ColNum, Sort_Type, Exact_Match)

End Sub

'' FastExcel's fast lookup
Public Function flookup(Lookup_value As Variant, _
Lookup_Range As Range, _
Answer_ColNum As Variant, _
Optional Sort_Type As Variant, _
Optional Exact_Match As Variant)
'
' FLOOKUP UDF: Fast Lookup
'
' find the Lookup_Value in the first column of Lookup_Range
' and return the corresponding row value from Answer_Colnum
'
' Sort_Type may be:
' -1 = sorted descending
' 1 = sorted ascending
' 0 = not sorted
'
' Exact_Match may be: True or False or any Non-Boolean value or string
' Exact_Match is returned if there is no exact match
'
' Sort_Type is optional and defaults to 1
' Exact_Match is optional and defaults to False if sorted, or #N/A if unsorted
'
Dim vAnsa As Variant ''' output to be assigned to function
Dim vRow As Variant ''' the row number found in Lookup_Range else error
Dim vNoMatch As Variant ''' the value to return if no exact match found
Dim lSorted As Long ''' -1 =descending, 0= not sorted, 1=ascending
Dim jAnswerColumn As Long ''' the answer column number in Lookup_Range
Dim blExact As Boolean ''' exact match flag
Dim blFound As Boolean ''' true if a match found
'
' setup error handler
'
On Error GoTo FuncFail
'
' skip execution if empty or uncalculated inputs
'
If IsEmpty(Lookup_value) Or IsEmpty(Lookup_Range(1, 1)) Or IsEmpty(Answer_ColNum) Then
Exit Function
End If
'
' convert defaults etc
'
SetDefaults Sort_Type, lSorted, Exact_Match, vNoMatch, blExact, _
Answer_ColNum, jAnswerColumn
'
' now try to find the lookup_value
'
blFound = False
If Not blExact Then
'
' approx match sorted requested
'
On Error Resume Next
vRow = Application.WorksheetFunction.Match(Lookup_value, Lookup_Range.Columns(1), lSorted)
If Err = 0 Then blFound = True
On Error GoTo FuncFail
Err.Clear
Else
'
' exact match requested
'
' first check memory, If matches then done
'
vRow = lMemoryId(Application.Caller)
If vRow > 0 Then
'
' check value in column 1 against Lookup_Value
'
If vRow <= Lookup_Range.Rows.Count Then
If Lookup_Range(vRow, 1) = Lookup_value Then
blFound = True
End If
End If
End If
'
' no memory or memory does not match
'
If Not blFound Then
'
' look for the row
'
vRow = Application.Match(Lookup_value, Lookup_Range.Columns(1), lSorted)
'
' if unsorted and nomatch vRow contains error
'
If Not IsError(vRow) Then
If lSorted = 0 Then
blFound = True
Else
'
' we have a potential row: check against Lookup_Value
'
If Lookup_Range(vRow, 1) = Lookup_value Then blFound = True
End If
End If
End If
End If
'
' return the value
'
If Not blFound Then
'
' unsuccessful Exact Match: return the given error value
'
flookup = vNoMatch
Else
'
' successful: get answer from column
'
flookup = Lookup_Range(vRow, jAnswerColumn)
End If
'
' store memory
'
If blExact Then
Call StoreID(Application.Caller, vRow)
End If
Exit Function
FuncFail:
flookup = CVErr(xlErrValue)
Exit Function
End Function
Private Sub SetDefaults(Sort_Type As Variant, lSorted As Long, Exact_Match As Variant, _
vNoMatch As Variant, blExact As Boolean, _
Answer_ColNum As Variant, jAnswerColumn As Long)
'
' sorted defaults to sort ascending : 1
'
lSorted = 1
If Not IsMissing(Sort_Type) Then lSorted = CLng(Sort_Type)
'
' set blExact and vNoMatch
'
vNoMatch = CVErr(xlErrNA)
blExact = True
'
If IsMissing(Exact_Match) Then
'
' Exact_Match defaults to False if Sorted, #N/A if unsorted
'
If lSorted <> 0 Then blExact = False
Else
'
' do exact match unless sorted and exact match=false
'
vNoMatch = Exact_Match
If VarType(vNoMatch) = vbBoolean And lSorted <> 0 Then
If Not vNoMatch Then blExact = False
End If
End If
'
' answer column must be convertible to long
'
jAnswerColumn = CLng(Answer_ColNum)
End Sub
Private Function lMemoryId(oCaller As Range) As Long
'
' get the ID from the calling cell and convert to long
'
Dim vID As Variant
lMemoryId = 0
On Error GoTo FuncFail
'
' ID property not available in Excel 97
'
If Val(Left(Application.Version, 2)) > 8 And Not oCaller Is Nothing Then
vID = oCaller.ID
If vID <> "" And IsNumeric(vID) Then
lMemoryId = CLng(vID)
End If
End If
FuncFail:
End Function
Private Sub StoreID(oCaller As Range, vRowNum As Variant)
'
' store the id in the calling cell
'
If Not oCaller Is Nothing And Val(Left(Application.Version, 2)) > 8 Then
oCaller.ID = CStr(vRowNum)
End If
End Sub