JohnExcel222
New Member
- Joined
- Dec 19, 2018
- Messages
- 35
- Office Version
- 365
Hi there,
I have a workbook, with the first sheet filled with values that I need to lookup in other sheets in the same workbook.
The code below works, but will lookup in another workbook.
I would like to amend it so that the code performs the lookup in the same workbook.
The sheets containing the lookup tables will be called: "T_Order", "T_Customer", "T_Facility"
Sub FindValue()
'here: lookup between two workbooks
'here: 2 columns between lookup and output value: here values searched in column B, output in column D (2 columns away)
'xRg.Offset(0, 2)
'change the offset number in the formula above (0, 2) to the number of columns needed
Dim xAddress As String
Dim xString As String
Dim xFileName As Variant
Dim xUserRange As Range
Dim xRg As Range
Dim xFCell As Range
Dim xSourceSh As Worksheet
Dim xSourceWb As Workbook
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xUserRange = Application.InputBox("Lookup values :", "xx", xAddress, Type:=8)
If Err <> 0 Then Exit Sub
Set xUserRange = Application.Intersect(xUserRange, Application.ActiveSheet.UsedRange)
xFileName = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", 1, "Select a Workbook")
If xFileName = False Then Exit Sub
Application.ScreenUpdating = False
Set xSourceWb = Workbooks.Open(xFileName)
Set xSourceSh = xSourceWb.Worksheets.Item(1)
xString = "='" & xSourceWb.Path & Application.PathSeparator & _
"[" & xSourceWb.Name & "]" & xSourceSh.Name & "'!$"
For Each xRg In xUserRange
Set xFCell = xSourceSh.Cells.Find(xRg.Value, , xlValues, xlWhole, , , False)
If Not (xFCell Is Nothing) Then
xRg.Offset(0, 2).Formula = xString & GetColumn(xFCell.Column + 1) & "$" & xFCell.Row
End If
Next
xSourceWb.Close False
Application.ScreenUpdating = True
End Sub
I have a workbook, with the first sheet filled with values that I need to lookup in other sheets in the same workbook.
The code below works, but will lookup in another workbook.
I would like to amend it so that the code performs the lookup in the same workbook.
The sheets containing the lookup tables will be called: "T_Order", "T_Customer", "T_Facility"
Sub FindValue()
'here: lookup between two workbooks
'here: 2 columns between lookup and output value: here values searched in column B, output in column D (2 columns away)
'xRg.Offset(0, 2)
'change the offset number in the formula above (0, 2) to the number of columns needed
Dim xAddress As String
Dim xString As String
Dim xFileName As Variant
Dim xUserRange As Range
Dim xRg As Range
Dim xFCell As Range
Dim xSourceSh As Worksheet
Dim xSourceWb As Workbook
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xUserRange = Application.InputBox("Lookup values :", "xx", xAddress, Type:=8)
If Err <> 0 Then Exit Sub
Set xUserRange = Application.Intersect(xUserRange, Application.ActiveSheet.UsedRange)
xFileName = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", 1, "Select a Workbook")
If xFileName = False Then Exit Sub
Application.ScreenUpdating = False
Set xSourceWb = Workbooks.Open(xFileName)
Set xSourceSh = xSourceWb.Worksheets.Item(1)
xString = "='" & xSourceWb.Path & Application.PathSeparator & _
"[" & xSourceWb.Name & "]" & xSourceSh.Name & "'!$"
For Each xRg In xUserRange
Set xFCell = xSourceSh.Cells.Find(xRg.Value, , xlValues, xlWhole, , , False)
If Not (xFCell Is Nothing) Then
xRg.Offset(0, 2).Formula = xString & GetColumn(xFCell.Column + 1) & "$" & xFCell.Row
End If
Next
xSourceWb.Close False
Application.ScreenUpdating = True
End Sub