Multiple Lookup in VBA
 

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

Multiple Lookup in VBA
 

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

"James B." wrote in message
...
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

Multiple Lookup in VBA
 

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

"James B." wrote in
message
...
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


.

Multiple Lookup in VBA
 

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

--
Regards,
Tom Ogilvy

"James B." wrote in message
...
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

"James B." wrote in
message
...
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


.

Multiple Lookup in VBA
 

Wow!!!!
Thanks a lot Tom, it worked great..thank you
-----Original Message-----
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

--
Regards,
Tom Ogilvy

"James B." wrote in
message
...
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

"James B." wrote
in
message
...
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


.



.