I need tips on improving my Multi Vlookup code

[abdul hafeel]

Hi,

I have an VBA module to perform Multi Column Vlookups. I am posting it here so that It can be improved. Current deficiencies

(1) Manually adjust code for performing more than 2 column lookups
(2) Crashes when the Lookup range has Null set

Advantages are
(1) its free!
(2) Unlike conventional Vlookup you can perform the Vlookup operation on the entire criteria lookup range. No need to select a single cell & then drag it down.

Pls help me improve my coding. I hope you find this useful.
My contact Email : EDIT: E-Mail address removed by moderator, code tags added & Welcome to the Board while we're at it!

Thanks in advance Fellow Coders


Here's the code

Sub SelectRange()
'****************************************************
'This section is for the Data Range criteria
Dim r, c As Integer
Dim m, N As Integer
Dim data As range

'*******************************************************************
Prompt = "Select a Valid Data Range for Lookup."
Title = "Select a valid Data Range"
'   Display the Input Box
    On Error Resume Next
    Set data = Application.InputBox( _
        Prompt:=Prompt, _
        Title:=Title, _
        Default:=ActiveCell.Address, _
        Type:=8) 'Range selection

'   Was the Input Box canceled?
    If data Is Nothing Then
        MsgBox "Canceled."
    Else
        
    End If
'*******************************************************************

'Application.Selection.Activate
data.Select
r = Selection.Rows.Count
c = Selection.Columns.Count
Dim RangeArray() As Variant
ReDim Preserve RangeArray(r, c)
N = o
Do Until N = c
m = 0
Do Until m = r
RangeArray(m, N) = ActiveCell.Offset(m, N).Value
'MsgBox RangeArray(m, n)
m = m + 1
Loop
N = N + 1

Loop
'*****************************************************
'Now This section is for the Lookup criteria
Dim x, y As Integer
Dim find As range
Dim Index As Variant
'*******************************************************************
'*******************************************************************
Prompt = "Select a Cell/Range for the output."
Title = "Select a Cell/Range"
'   Display the Input Box
    On Error Resume Next
    Set find = Application.InputBox( _
        Prompt:=Prompt, _
        Title:=Title, _
        Default:=ActiveCell.Address, _
        Type:=8) 'Range selection

'   Was the Input Box canceled?
    If find Is Nothing Then
        MsgBox "Canceled."
    Else
        
    End If
'*******************************************************************

On Error Resume Next
MsgBox range(find).Address
'range(find).Select
find.Select
x = Selection.Rows.Count
y = Selection.Columns.Count
ReDim Index(x, y)

N = o
Do Until N = y
m = 0
Do Until m = x
Index(m, N) = ActiveCell.Offset(m, N).Value
m = m + 1
Loop
N = N + 1
Loop

Call SearchArray(RangeArray, Index, 3)
End Sub

Function SearchArray(Array2 As Variant, criteria As Variant, N As Integer)
Dim a, b, c As Integer
b = 0
Do Until b = UBound(criteria)
a = 0
Do Until a = UBound(Array2)
'Code that actually does the VLookup Job!
'*********************************************
If criteria(b, 0) = Array2(a, 0) Then       '*
If criteria(b, 1) = Array2(a, 1) Then       '*
'MsgBox Array2(a, 2)                        '*
'MsgBox ActiveCell.Offset(b, 2).Value       '*                                            '*
If ActiveCell.Offset(b, 2).Value = "" Then  '*
ActiveCell.Offset(b, 2) = Array2(a, 2)      '*
End If                                      '*
End If                                      '*
End If                                      '*
'*********************************************
a = a + 1
Loop
b = b + 1
Loop

End Function