Multiple Lookup in VBA

[James B.]

Hi

I have created the following generic function which use
Excel Vlookup function to find the exact match. It works
fine however I am trying to create another function
similar to this but which would return multple matches in
an array e.g if their are dupliacets get all exact matches
of the part # with corsponding values. Is it possible &
how.

Function SearchSku(Pno As String, WB As String, Sheet As
String, SCol As Long, GetCol As Long)
Res = ""

Dim wks As Worksheet

Set wks = Workbooks(WB).Sheets(Sheet)
Set r = wks.Range(wks.Cells(1, SCol), wks.Range
("IV60000"))

Res = Application.VLookup(Pno, r, GetCol, False)
If IsError(Res) Then
SearchSku = ""
Else
SearchSku = Res
End If

End Function


Thanks a million

James B.
Xl2K vba

 

[Tom Ogilvy]

will the function be used in a worksheet like a built in function, or just
called from a VBA routine? Based on how you will use it could affect what
solution is chosen.

 

[James B.]

Hi Tom
It will be called from VBA routine.
Thanks

-----Original Message-----
will the function be used in a worksheet like a built in function, or just
called from a VBA routine? Based on how you will use it could affect what
solution is chosen.

--
Regards,
Tom Ogilvy




.

 

[Tom Ogilvy]

Driver is a sample routine to call the function. Lightly tested, so you many
need to add some error handling.

Sub Driver1()
Dim sStr As String, sStr1 As String
Dim icol As Long, gcol As Long
Dim i As Long
sStr = "Book2"
sStr1 = "Sheet1"
icol = 2
gcol = 5
varr = arrSearchSku("AMAE", sStr, sStr1, icol, gcol)
For i = LBound(varr) To UBound(varr)
Debug.Print i, varr(i)
Next
End Sub

Function arrSearchSku(Pno As String, _
WB As String, Sheet As String, SCol As Long, _
GetCol As Long)
Dim r As Range, cell As Range
Dim r1 As Range, r2 As Range

Dim wks As Worksheet

Set wks = Workbooks(WB).Sheets(Sheet)
Set r = wks.Cells(1, SCol)
Set r1 = wks.Cells(1, SCol).CurrentRegion
Set r1 = r1(r1.Count)
Set r = wks.Range(r, r1)
Debug.Print r.Address
If wks.AutoFilterMode Then wks.AutoFilterMode = False
r.AutoFilter Field:=1, Criteria1:=Pno
Set r1 = wks.AutoFilter.Range.Columns(GetCol).Cells
On Error Resume Next
Set r2 = r1.Offset(1, 0).Resize(r1.Rows.Count,
1).SpecialCells(xlVisible)
On Error GoTo 0
If Not r2 Is Nothing Then
ReDim varr(1 To r2.Count)
i = 1
For Each cell In r2
varr(i) = cell.Value
i = i + 1
Next
wks.AutoFilterMode = False
arrSearchSku = varr
Else
ReDim varr(1 To 1)
arrSearchSku = varr
End If

End Function

 

[James B.]

Wow!!!!
Thanks a lot Tom, it worked great..thank you