Excel VBA Vlookup
There's a few things that you can do to improve your code: use ranges for your input boxes, and
don't loop through the cells - do them all at once using formulas. And never name a macro with a
used function name - that's bad practice.
See the code below for a very flexible VLOOKUP formula creation routine - the lookup values,
results, and data table can be on any sheet in the workbook, anywhere. And it can leave the formula
as a formula....
HTH,
Bernie
MS Excel MVP
Option Explicit
Dim FirstRow As Long
Dim FinalRow As Long
Dim myValues As Range
Dim myRange As Range
Dim myResults As Range
Dim myCount As Integer
Sub VlookupMacro()
Set myValues = Application.InputBox("Please select the first cell in" & _
" the column with the values that you're looking for", Type:=8)
Set myResults = Application.InputBox("Please select the first cell " & _
" where you want your lookup results to start ", Type:=8)
Set myRange = Application.InputBox("Please select the entire lookup data table range" & _
" - with the desired values as the last column", Type:=8)
myCount = myRange.Columns.Count
On Error Resume Next
myResults.EntireColumn.Insert Shift:=xlToRight
Set myResults = myResults.Offset(, -1)
FirstRow = myValues.Row
FinalRow = Cells(65536, myValues.Column).End(xlUp).Row
Range(myResults, myResults.Offset(FinalRow - FirstRow)).Formula = _
"=VLOOKUP(" & Cells(FirstRow, myValues.Column).Address(False, False, , True) & ", " & _
myRange.Address(True, True, , True) & "," & myCount & ", False)"
If MsgBox("Do you want to convert to values?", vbYesNo) = vbNo Then Exit Sub
Columns(myResults.Column).Copy
Columns(myResults.Column).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
wrote in message
oups.com...
Hello
This is my first Excel VBA to publish in the forum and happy to join
the Excel VBA family.
Excel vlookup function is very useful in many applications.
I develop a VBA to make Vlookup run faster if you havew many rows to
lookup
, please try the code.
I appreciate your comment.
Option Explicit
Dim finalrow As Integer
Dim Mysheet As String
Dim mycolumn As Long
Dim Myrange As String
Dim mycount As Long
Dim i As Integer
Dim mylookup As Variant
Dim mystring As String
Dim myvalue As Long
Sub Vlookup()
mycolumn = Application.InputBox("Please enter the lookup column
number", Type:=1)
myvalue = Application.InputBox("Please enter the column number you want
to place your lookup up result ", Type:=1)
Mysheet = InputBox("Please enter lookup worksheet name",
"WorksheetName", Default)
Myrange = InputBox("Please enter lookup range", "Range", Default)
mycount = Range(Myrange).Columns.Count
On Error Resume Next
Columns(myvalue).Insert Shift:=xlToRight
finalrow = Cells(65536, mycolumn).End(xlUp).Row
For i = 1 To finalrow
mystring = (Cells(i, mycolumn))
mylookup = Application.Vlookup((mystring),
Worksheets(Mysheet).Range(Myrange), mycount, False)
Cells(i, myvalue).Value = mylookup
Next i
End Sub
|