VBA code For Giving Link like Vlookup
Step;-1 Give reference Of Source Data And Lookup Data
Step—2 Remove ‘ from Formula
Step-3 replace Colum with desired Colum
Sub GetCellReferences()
Dim sourceSheet As Worksheet
Dim lookupSheet As Worksheet
Dim sourceRange As Range
Dim lookupRange As Range
Dim sourceData As Variant
Dim lookupData As Variant
Dim resultData As Variant
Dim lookupValue As Variant
Dim resultArray() As Variant
Dim i As Long
On Error Resume Next
' Select the source sheet and range using a single input box
Set sourceRange = Application.InputBox("Select the range for the source data (including sheet
name and range):", Type:=8)
If sourceRange Is Nothing Then Exit Sub
' Extract the source sheet and range from the selected range
Set sourceSheet = ThisWorkbook.Sheets(Split(sourceRange.Address, "!")(0))
Set sourceRange = sourceSheet.Range(Split(sourceRange.Address, "!")(1))
' Select the lookup sheet and range using a single input box
Set lookupRange = Application.InputBox("Select the range for the lookup data (including sheet
name and range):", Type:=8)
If lookupRange Is Nothing Then Exit Sub
' Extract the lookup sheet and range from the selected range
Set lookupSheet = ThisWorkbook.Sheets(Split(lookupRange.Address, "!")(0))
Set lookupRange = lookupSheet.Range(Split(lookupRange.Address, "!")(1))
On Error GoTo 0
' Read the source data into an array
sourceData = sourceRange.Value
' Read the lookup data into an array
lookupData = lookupRange.Value
' Resize the result array to match the size of the lookup data
ReDim resultArray(1 To UBound(lookupData, 1), 1 To 1)
' Loop through each lookup value and find the corresponding cell reference
For i = 1 To UBound(lookupData, 1)
lookupValue = lookupData(i, 1)
resultArray(i, 1) = GetCellReference(sourceData, lookupValue, sourceRange)
Next i
' Write the result array to the adjacent column of the lookup range
lookupRange.Offset(0, 1).Value = resultArray
' Cleanup
Set sourceSheet = Nothing
Set lookupSheet = Nothing
Set sourceRange = Nothing
Set lookupRange = Nothing
MsgBox "Cell references have been populated successfully.", vbInformation
End Sub
Function GetCellReference(data As Variant, lookupValue As Variant, sourceRange As Range) As
String
Dim rng As Range
Dim resultRange As Range
On Error Resume Next
Set rng = Application.Intersect(sourceRange, sourceRange.Parent.UsedRange)
On Error GoTo 0
If Not rng Is Nothing Then
Set resultRange = rng.Find(lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
If Not resultRange Is Nothing Then
GetCellReference = "'" & resultRange.Parent.Name & "'!" & resultRange.Address
Else
GetCellReference = "Not Found"
End If
End If
End Function
