Find cells and insert hyperlinks with Excel VBA macros

This page shows, how a macro can find cells with a certain text or value and then insert hyperlinks to the cells found.

I wrote the example, when a reader asked for help. He had a workbook with many sheets including an "overview sheet" with key data from the other sheets.

Instead of using Excel's search function, he wanted to write a search string in a cell and then run a macro that would find all cells with the same text and insert hyperlinks to these cells.

Below is an example doing just that. You can also download a zipped demo version of the spreadsheet. The example takes advantage of the fact, that every worksheet has a Worksheet_Change procedure, that can detect when something happens to a cell.

When the user writes something in a cell on the sheet with key data, the cell is set as a public range variable, and when the user runs the macro "FindText," all worksheets (except the one with key data) are searched for cells with the same text.

If the macro finds one or more cells, the user must indicate (click) where to insert the hyperlinks. For the example to work the workbook must have a worksheet named "Overview".

Step 1:

Every worksheet in a workbook has its own code sheet, and there are some pre-defined standard procedures that - if activated - are called automatically if certain things happen on the sheet.

In this case we use the Worksheet_Change procedure, which is called when a cell (or a range of cells) is changed.

Open Excel's VBA editor (ALT+F11) and doubleclick on the Overview's code sheet. If you cannot see it, open Project Explorer by pressing CTRL+R. Mark and copy (CTRL+C) the following code and paste it (CTRL+V) into the worksheet's code sheet.

Private Sub Worksheet_Change(ByVal Target As Range)

'When a cell has changed the public
'variable, rCell, is set = the same cell.
Set rCell = Target
End Sub

Step2: Find cells and insert hyperlinks

You must insert a standard module and declare the public variable, rCell, at the module top:

Public rCell As Range

And now to the core macro. To test it, hightlight the code with the mouse, copy (CTRL+C) and paste (CTRL+V) into the VBA module, or you can download the zipped spreadsheet.

Sub FindText()
Dim bStart As Boolean
Dim bFound As Boolean
Dim lCount As Long
Dim lCellCount As Long
Dim rSearch As Range
Dim rInsert As Range
Dim sText As String
Dim sFirstAddress As String
Dim sTargetAddress As String

On Error GoTo ErrorHandle

'If no cell has been changed in the Overview sheet,
'rCell hasn't been set as a range variable, and we exit.
If rCell Is Nothing Then
   MsgBox "No cell has changed"
   GoTo BeforeExit
End If

'If there is nothing to search for, we exit.
'This could happen, if the user writes something
'in a cell and then presses ESC. It could also be
'a format change.
If Len(rCell.Value) = 0 Then GoTo BeforeExit

'The string to search for is set = the value of the last cell changed.
sText = rCell.Value

'We now look through all the worksheets except the Overview sheet.
'"Worksheets" is a collection in the Workbook object.
For lCount = 1 To Worksheets.Count

   'If the Overview sheet has another name than "Overview"
   'you must change it in the line below and further
   'down. Use search and replace.
   If Worksheets(lCount).Name <> "Overview" Then
      'We search the range A1:IV30000 for cells
      'with the search string. You can change the
      'range in the line below.
      With Worksheets(lCount).Range("A1:IV30000")
         Set rSearch = .Find(sText, LookIn:=xlValues)
         If Not rSearch Is Nothing Then
            sFirstAddress = rSearch.Address
            If bStart = False Then
               'The user must now point to the cell
               'that should contain the first hyperlink.
               'Any other links will be inserted below.
               Worksheets("Overview").Activate
               Set rInsert = _
               Application.InputBox(prompt:="Click " & _
               "the cell where you " & _
               "want the first hyperlink.",Type:=8)
               
               'We set a flag that the cell has been selected.
               bStart = True
               
               'Flag for text found
               bFound = True
            End If

            'Inserts the first hyperlink for the
            'present sheet in the Overview sheet.
            With Worksheets("Overview")
               sTargetAddress = "'" & Worksheets(lCount).Name _
               & "'!" & sFirstAddress

               .Hyperlinks.Add _
               Anchor:=rInsert.Offset(lCellCount, 0), _
               Address:="", SubAddress:=sTargetAddress, _
               TextToDisplay:=sTargetAddress
            End With

            '1 is added to the counter, so the next
            'hyperlink will be in the cell below the previous.
            lCellCount = lCellCount + 1

            'The loop below will find any extra
            'occurrences on the present sheet.
            Do
               rSearch.Value = sText
               Set rSearch = .FindNext(rSearch)
               If Len(rSearch.Value) > 0 And _
                  rSearch.Address <> sFirstAddress Then
                  With Worksheets("Overview	")
                     sTargetAddress = "'" & Worksheets(lCount).Name _
                     & "'!" & rSearch.Address

                     .Hyperlinks.Add Anchor:=rInsert.Offset _
                     (lCellCount, 0), Address:="", _
                     SubAddress:=sTargetAddress, _
                     TextToDisplay:=sTargetAddress
                  End With
                  lCellCount = lCellCount + 1
               End If
            Loop While Not rSearch Is Nothing _
            And rSearch.Address <> sFirstAddress
         End If
      End With
   End If
Next

'If the search didn't find anything.
If bFound = False Then
   MsgBox "There are no more cells with " & sText
End If

BeforeExit:
Set rInsert = Nothing
Set rSearch = Nothing
Set rCell = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure FindText."
Resume BeforeExit
End Sub

That was it. If you prefer the hyperlinks inserted horizontally, you must change: