VBA loop through column and extract embedded hyperlink and create clickable hyperlink

Hello,

I have data in a spreadsheet column 4 that is formatted like this:

"DOC1#http://acmecorp.com/urlfiles/Doc1.pdf"

This an export from MS Access table and the inclusion of the "#" allows the hyperlink to be clickable within the table (MS Accesses way of creating the "friendly name" and "location" in one line.

Additionally, some of the rows have empty column cells and others have just static text without a hyperlink - i.e. "Document unavailable", or "N/A". These just need to be ignore.

I'd like to loop through all rows to reformat the data in each cell so that it's now clickable via the Excel output file.

So the Visible/Friendly name is "DOC1" and the location is the "Http://acmecorp.com/urlfiles/Doc1.pdf" And the "#" is just removed altogether.

VBA needed:

• For loop to check each row in sheet and check data in column 4 cell
• See if there is a hyperlink in the cell "i.e. Find *http://" Then if it's there
• Copy all text AFTER the "#" character
• Store in string
• Delete everything AFTER and INCLUDING the "#" to leave just the name of the doc
• Use remaining text in cell (i.e. DOC1) as the Visible part of the hyperlink
• Paste copied hyperlink from string as the "location" part of the hyperlink
  
• If "http://" is not there, just ignore and move on to next row

Can the HYPERLINK function be used? (HYPERLINK(link_location, [friendly_name]))

Thank you in advance for your assistance.

Update - I've tried the following, but get an error at the ".Hyperlink.Add" part. (Run-time error '483': Object doesn't support this property or method)

Private Sub TestMe()
Dim lastrow As Integer
Dim contents As String
Dim link As String
Dim friendly As String
Dim i As Integer

With ActiveSheet

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastrow

contents = .Range("L" & i).Value

If Len(contents) > 20 Then

friendly = Left(contents, InStr(contents, "#") - 1)

link = Right(contents, Len(contents) - InStr(contents, "#"))

.Hyperlink.Add Anchor:=.Range("L" & i), Address:=link, TextToDisplay:=friendly

Else
End If

Next i

End With

End Sub

Maybe this way ?

Option Explicit

Sub Hyper_Add_Links()
    ' DOC1#http://acmecorp.com/urlfiles/Doc1.pdf
    Const crt1 = "#http://"
    Const crt2 = ".pdf"
    Const dlmtr = "#"
    
    Dim c As Long, r As Long, rws As Long
    Dim sadr As String, st As String
    Dim tbl, txt
    
    c = 4
    sadr = ""
    st = "Click me, Click me, Click me .... :)"
    
    With ThisWorkbook.Sheets("Sheet1")
        rws = .Cells(.Rows.Count, c).End(xlUp).Row
        tbl = .Range(Cells(1, c), Cells(rws, c)).Value
        For r = 1 To rws
            If InStr(1, tbl(r, 1), crt1, 0) <> 0 Then
                If Right$(RTrim$(tbl(r, 1)), Len(crt2)) = crt2 Then
                    txt = Split(Application.Clean(tbl(r, 1)), dlmtr, -1, 0)
                    ' .Cells(r, c) => only if column #4 has no header
                    .Hyperlinks.Add Anchor:=.Cells(r, c), _
                                    Address:=Trim$(txt(1)), SubAddress:=sadr, _
                                    ScreenTip:=st, TextToDisplay:=Trim$(txt(0))
                End If
            End If
        Next
    End With
End Sub