Use the value of an active cell to hyperlink (or VBA) to the same value on another sheet in same workbook - excel

Question

I am a fairly advanced excel user, but limited experience in VBA coding; can anyone give me a hand, or start me in the right direction please?
I have two sheets with tables:
The first (MASTER) sheet has product information which includes a unique stock code (SKU); it also identifies the SKU of any product which can be used as a substitute for that first product as a separate column entry. Both the product details of the MASTER product and the potential SUBSTITUTE product are in this MASTER sheet table.
The second (SUBSTITUTE) sheet is filtered to show the products which have potential substitutes along with the SKU of that potential substitute. It gets this information from the MASTER sheet and table.
I want to be able to select the potential substitute SKU cell on the SUBSTITUTE sheet, and then either hyperlink or use VBA to use that value to jump to the cell in the MASTER sheet that has that same value as that in the SUBSTITUTE’s cell.
In summary the pseudo code is:
Go to SUBSTITUTE worksheet
Position/select on a SKU code in the table
THE CODING WOULD START HERE. (VBA OR HYPERLINK)
Get that cell’s value and store as a variable
JUMP to MASTER worksheet
Find the value of the variable in the SKU column (SKUs are unique)
Make that cell with the same valu as the variable the active cell
Is it do-able?
Thanks in advance

Answer 1

Terry, the macro below may take care of most of your needs. You can create a keyboard shortcut for this macro and each time you run the macro, it will search for the text in the (SUBSTITUTE-sheet) cell you selected, in the MASTER sheet in your excel file and will show it to you. After that you can manually change the data or you can edit macro according to your needs. See sample screenshots below.
Sub Macro4()
my_text = Selection.Value
Sheets("MASTER").Activate
Cells.Select
On Error GoTo my_err
Selection.Find(What:=my_text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Exit Sub
my_err: MsgBox "search text not found"
Sheets("SUBSTITUTE").Select
End Sub

Answer 2

Activate Cell on Another Worksheet
Adjust the values in the constants section.
This runs automatically (on its own), there's nothing to run manually.
When you select a SKU cell in the Substitute worksheet, it activates the cell containing the same SKU value in the Master worksheet making it the top-most and left-most cell (modify if necessary).
Sheet Module e.g. Substitute
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
SelectSKU Target
End Sub
Standard Module e.g. Module1
Option Explicit
Sub SelectSKU(ByVal Target As Range)
' Source
Const shRow As Long = 1
Const sTitle As String = "SKU"
' Destination
Const dName As String = "Master"
Const dhRow As Long = 1
Const dTitle As String = "SKU"
' Source
If Target Is Nothing Then Exit Sub
Dim ws As Worksheet: Set ws = Target.Worksheet
If shRow < 1 Then Exit Sub ' Source Header Row too small
If shRow >= ws.Rows.Count Then Exit Sub ' Source Header Row too great
Dim shCell As Range: Set shCell = RefHeader(ws, sTitle, shRow)
If shCell Is Nothing Then Exit Sub ' Source Header not found
Dim scrg As Range: Set scrg = RefColumn(shCell.Offset(1))
If scrg Is Nothing Then Exit Sub ' Source Range is empty
Dim sCell As Range: Set sCell = Intersect(Target.Cells(1), scrg)
If sCell Is Nothing Then Exit Sub ' cell not in Source Range
If IsError(sCell) Then Exit Sub ' cell contains an error
If Len(sCell.Value) = 0 Then Exit Sub ' cell is blank i.e. no SKU value
Dim sValue As String: sValue = CStr(sCell.Value)
' Destination
If dhRow < 1 Then Exit Sub ' Destination Header Row too small
If dhRow >= ws.Rows.Count Then Exit Sub ' Destination Header Row too great
Dim dws As Worksheet: Set dws = RefWorksheet(ws.Parent, dName)
If dws Is Nothing Then Exit Sub ' Destination Worksheet not found
Dim dhCell As Range: Set dhCell = RefHeader(dws, dTitle, dhRow)
If dhCell Is Nothing Then Exit Sub ' Destination Header not found
Dim dcrg As Range: Set dcrg = RefColumn(dhCell.Offset(1))
If scrg Is Nothing Then Exit Sub ' Destination Range is empty
Dim dcell As Range: Set dcell = dcrg.Find(sValue, _
dcrg.Cells(dcrg.Cells.Count), xlFormulas, xlWhole)
If dcell Is Nothing Then Exit Sub ' SKU not found in Destination Range
dws.Activate
dcell.Activate
' Optional. Remove or modify one or both if you don't like it.
With ActiveWindow
.ScrollRow = dcell.Row
.ScrollColumn = dcell.Column
End With
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: In a row ('HeaderRow') of a worksheet ('ws'), creates
' a reference to the first cell whose value is equal
' to a string ('Title'). Case-insensitive.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefHeader( _
ByVal ws As Worksheet, _
ByVal Title As String, _
Optional ByVal HeaderRow As Long = 1) _
As Range
If ws Is Nothing Then Exit Function
If HeaderRow < 1 Then Exit Function
If HeaderRow > ws.Rows.Count Then Exit Function
With ws.Rows(HeaderRow)
Set RefHeader = .Find(Title, .Cells(.Cells.Count), xlFormulas, xlWhole)
End With
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to the one-column range from the first cell
' of a range ('rg') through the bottom-most non-empty cell.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
ByVal rg As Range) _
As Range
If rg Is Nothing Then Exit Function
With rg.Cells(1)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Function
Set RefColumn = .Resize(lCell.Row - .Row + 1)
End With
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: In a workbook ('wb'), creates a reference to the worksheet
' named after a string ('WorksheetName').
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefWorksheet( _
ByVal wb As Workbook, _
ByVal WorksheetName As String) _
As Worksheet
If wb Is Nothing Then Exit Function
On Error Resume Next
Set RefWorksheet = wb.Worksheets(WorksheetName)
On Error GoTo 0
End Function