Convert Cells Containing Hyperlink Formulas to just a Hyperlinked Cell with the Text value

[sspatriots]

I'm trying to convert several hyperlink formulas to anchored hyperlinks with just the text value left in the cell. The code I have so far only does the top cell in the range (selected cells in a column), but it also renames the value in the top cell to the actual value in the bottom cell of the selected range. Then the rest of the cells in the selected range won't loop through and take out the hyperlink formulas. Any ideas would be appreciated. Thanks, SS

I wanted to add that if I just select one cell with a hyperlink formula in it, the code will work on that one cell.

Sub convert_hyperlink_formula_to_hyperlink_cell()
Dim address_string As String, display_string As String
Dim current_range As Range
Dim cel As Range

Set current_range = Application.Selection

For Each cel In current_range.Cells

    Debug.Print cel.Address, cel.Value

    address_string = Mid(cel.Formula, 13, InStr(19, cel.Formula, ".") - 9)
    display_string = cel.Value
    ActiveSheet.Hyperlinks.Add Anchor:=cel, Address:=address_string, TextToDisplay:=display_string
    ActiveCell.Value = display_string

Next cel

End Sub

 

[sspatriots]

If anyone can assist with this, it would be greatly appreciated. I'm thinking it is something simple that I'm missing here. Sometimes I can't see the forest for the trees with this stuff. Thanks

 

[sspatriots]

Well I managed to figure it out in under an hour this morning. Amazing what a good nights sleep will do. Not only did I get it to work, I managed to re-write it to filter through the entire column. Sharing both in case it helps someone else.

Sub convert_hyperlink_formula_to_hyperlink_cell()

Dim address_string As String, display_string As String
Dim current_range As Range
Dim cel As Range

Set current_range = Application.Selection

For Each cel In current_range.Cells
   
    Debug.Print cel.Address, cel.Value

    address_string = Mid(cel.Formula, 13, InStr(19, cel.Formula, ".") - 9)
    display_string = cel
    ActiveSheet.Hyperlinks.Add Anchor:=cel, Address:=address_string, TextToDisplay:=display_string
    cel = cel.Value

Next cel

End Sub

This one does the entire column and looks for the formulas only:

Sub convert_hyperlink_formula_to_hyperlink_cell_entire_column()

Dim ws As Worksheet     'Added, SPS, 09/28/22
Dim tblPO As ListObject     'Added, SPS, 09/28/22
Dim address_string As String, display_string As String
Dim cell As Range

Set ws = ThisWorkbook.Sheets("2022")     'Added, SPS, 09/28/22
Set tblPO = ws.ListObjects("Table46")     'Added, SPS, 09/28/22

For Each cell In tblPO.ListColumns("PO#").DataBodyRange
    
    If cell.HasFormula = True Then
    
        address_string = Mid(cell.Formula, 13, InStr(19, cell.Formula, ".") - 9)
        display_string = cell
        ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:=address_string, TextToDisplay:=display_string
        cell = cell.Value

    End If

Next cell

End Sub