PDA

View Full Version : vlookup on temp file



ksp
03-05-2016, 09:40 AM
Hi Folks, I need some help on the vlookup code.

Very often I have to open files from my mails for which I have to do a vlookup manually. Each time I have to reference the vlookup manually with the other file which is saved on my laptop.(staff details). Is there a way to run the macro directly on this temporary file that I open from the mail . I tried the below
Sub anywherelookup()

Dim y As Integer
Dim MyLookup As Worksheet

MyLookup = Worksheets("Sheet1").Range("a1:I27") ' this file at the "E:\Backup_27 Feb\Macro\staff details.xlsx" location

y = InputBox("Select to Column where data should be displayed in the temp file from the mail")

For x = 2 To 26
ActiveSheet.Cells(x, y).Value = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(x, 1).Value, MyLookup, 9, False)
Next x

End Sub

Regards

Karan

mikerickson
03-05-2016, 12:39 PM
You might try this:

Sub test()
Dim DataWorkbook As Workbook
Dim DataRange As Range
Dim PathToData As String
Dim DataWBName As String
Dim ResultRange As Range

PathToData = Application.GetOpenFilename
If PathToData = "False" Then Exit Sub: Rem cancel pressed
DataWBName = Mid(PathToData, InStrRev(PathToData, Application.PathSeparator) + 1)

On Error Resume Next
If Workbooks(DataWBName) <> DataWBName Then
Set DataWorkbook = Workbooks.Open(PathToData)
Else
Set DataWorkbook = Workbooks(DataWBName)
End If
On Error GoTo 0

Set DataRange = DataWorkbook.Sheets("Sheet1").Range("A1:I27")

ThisWorkbook.Activate

Do
On Error Resume Next
Set ResultRange = Application.InputBox("select the result column with the mouse", Type:=8)
On Error GoTo 0

If ResultRange Is Nothing Then Exit Sub: Rem cancel pressed

If ResultRange.Column = 1 Then MsgBox "Do not select a cell in column A"
Loop Until ResultRange.Column <> 1

With ResultRange.Cells(1, 1)
With Application.Intersect(.EntireColumn, .Parent.Range("2:26").EntireRow)
.FormulaR1C1 = "=VLOOKUP(RC1," & DataRange.Address(True, True, xlR1C1, True) & ",9,false)"
.Value = .Value
End With
End With
End Sub

ksp
03-06-2016, 06:11 AM
Hi mikerickson,

Thanks, works perfectly...but since I am a relatively new to this, could I bother you to interpret the below code in a short paragraph so my understanding in better especially the last bit on the intersect bit.

Many thanks for taking out time on this.

Karan


You might try this:

Sub test()
Dim DataWorkbook As Workbook
Dim DataRange As Range
Dim PathToData As String
Dim DataWBName As String
Dim ResultRange As Range

PathToData = Application.GetOpenFilename
If PathToData = "False" Then Exit Sub: Rem cancel pressed
DataWBName = Mid(PathToData, InStrRev(PathToData, Application.PathSeparator) + 1)

On Error Resume Next
If Workbooks(DataWBName) <> DataWBName Then
Set DataWorkbook = Workbooks.Open(PathToData)
Else
Set DataWorkbook = Workbooks(DataWBName)
End If
On Error GoTo 0

Set DataRange = DataWorkbook.Sheets("Sheet1").Range("A1:I27")

ThisWorkbook.Activate

Do
On Error Resume Next
Set ResultRange = Application.InputBox("select the result column with the mouse", Type:=8)
On Error GoTo 0

If ResultRange Is Nothing Then Exit Sub: Rem cancel pressed

If ResultRange.Column = 1 Then MsgBox "Do not select a cell in column A"
Loop Until ResultRange.Column <> 1

With ResultRange.Cells(1, 1)
With Application.Intersect(.EntireColumn, .Parent.Range("2:26").EntireRow)
.FormulaR1C1 = "=VLOOKUP(RC1," & DataRange.Address(True, True, xlR1C1, True) & ",9,false)"
.Value = .Value
End With
End With
End Sub

mikerickson
03-06-2016, 07:45 AM
The inputBox sets the ResultRange variable to one cell. We want to work with rows 2:26 of that cell's column


With ResultRange.Cells(1,1): Rem specify top left cell in case the user selects multi-column range

Rem Intersection of entire column of user's cell with range _
2:26 of its sheet is the return range we want to fill
With Application.Intersect(.EntireColumn, .Parent.Range("2:26").EntireRow)

Rem fill that range with a VLOOKUP formula
Rem search term from column 1 (column A) and the data rage from the dataworbook
.FormulaR1C1 = "=VLOOKUP(RC1," & DataRange.Address(True, True, xlR1C1, True) & ",9,false)"

Rem change those formulas into their values (equivalent to copy pastespecial/values)
.Value = .Value

End With
End With