Search Data with VBA Code

[lojanica]

The code below is used to locate array data from the tab "2 Technician Report" in the range C6:G84 and look up only the data in the range E6:E84. When a word is entered in cell B2 of the "Tech Report Search" tab, the code looks up the array and returns any line matching the entered word. This part is working great.

However, there is an issue with the hyperlinks in the range G6:G84. Usually, the text or number in this range is linked to a hyperlink. When the data gets filtered, the hyperlink is not correct after the first search. The text in row G is updated correctly, but it seems like the hyperlink from the first search is being repeated.

For example, in the snapshots, I first performed a search for "test" and the links were working fine. Once I searched for an updated name, the links were correct, but the hyperlinks were the same as those from the "test" search.

Can anyone help me understand what I am doing wrong?

Function FilterWithHyperlinks(rng As Range, criteria As String) As Variant
    Dim cell As Range
    Dim result() As Variant
    Dim i As Long, j As Long, k As Long
    Dim colCount As Long
    
    colCount = rng.Columns.Count
    j = 1
    
    For Each cell In rng.Columns(3).Cells ' Assuming column E is the 3rd column in the range C6:G84
        If InStr(1, cell.Value, criteria, vbTextCompare) > 0 Then
            ReDim Preserve result(1 To colCount, 1 To j)
            For k = 1 To colCount
                result(k, j) = cell.Offset(0, k - 3).Value ' Adjusting offset to match the column in the range
            Next k
            j = j + 1
        End If
    Next cell
    
    If j = 1 Then
        FilterWithHyperlinks = "Nothing"
    Else
        FilterWithHyperlinks = result
    End If
End Function

Sub CreateClickableHyperlinks()
    Dim result As Variant
    Dim i As Long, j As Long
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Tech Report Search") ' Change to your sheet name
    
    ' Clear previous search results and hyperlinks
    ws.Range("B4:F100").ClearContents ' Adjust the range as needed
    Dim hl As Hyperlink
    For Each hl In ws.Hyperlinks
        If Not Intersect(hl.Range, ws.Range("B4:F100")) Is Nothing Then
            hl.Delete
        End If
    Next hl
    
    ' Check if B2 is blank
    If ws.Range("B2").Value = "" Then
        ws.Range("B4").Value = "Nothing"
        Exit Sub
    End If
    
    result = FilterWithHyperlinks(Sheets("2 Technician Report").Range("C6:G84"), ws.Range("B2").Value)
    
    If IsArray(result) Then
        For i = LBound(result, 2) To UBound(result, 2)
            For j = LBound(result, 1) To UBound(result, 1)
                If result(j, i) <> "" Then
                    ws.Cells(4 + i - 1, 2 + j - 1).Value = result(j, i)
                    If j = 5 Then ' Assuming hyperlinks are in the 5th column (G)
                        Dim hyperlinkAddress As String
                        hyperlinkAddress = Sheets("2 Technician Report").Cells(6 + i - 1, 7).Hyperlinks(1).Address ' Adjusting for the correct row and column
                        If IsValidURL(hyperlinkAddress) Then
                            On Error Resume Next ' Ignore errors temporarily
                            ws.Hyperlinks.Add Anchor:=ws.Cells(4 + i - 1, 2 + j - 1), Address:=hyperlinkAddress, TextToDisplay:=result(j, i)
                            On Error GoTo 0 ' Turn error handling back on
                        Else
                            ws.Cells(4 + i - 1, 2 + j - 1).Value = "Invalid URL"
                        End If
                    End If
                End If
            Next j
        Next i
    Else
        ws.Range("B4").Value = result
    End If
End Sub

Function IsValidURL(url As String) As Boolean
    On Error GoTo InvalidURL
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.Open "HEAD", url, False
    http.send
    If http.Status = 200 Then
        IsValidURL = True
    Else
        IsValidURL = False
    End If
    Exit Function
InvalidURL:
    IsValidURL = False
End Function