Copy hyperlinks from one table column to another. The columns are identical

[sspatriots]

This is the same code I was working with earlier that I had posted a different issue with that seems to be working fine now. However, when I get to the lines below, I would like to try and get these to where all that is needed is have the hyperlinks in "rng4" show up on the same column in another table called "rng5". My first try was to copy the formats from "rng5" to "rng4" first and then copy everything back to "rng5" so that I didn't lose the original cell formatting of "rng5". I would like to do this without having to use copy and past and somehow set ranges equal to one another, because I understand that selecting ranges to copy and paste from one range to another slows the code down. Any suggestions would me greatly appreciated. Thanks, SS

    rng5.Copy
    rng4.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
    

    rng4.Copy
    rng5.PasteSpecial.Hyperlinks (1)

Sub CreateHyperlinks2024()

    Dim wb1 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim tb1 As ListObject, tb2 As ListObject
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range
    Dim cl As Range
    Dim numRows As Long
    
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("2024")
    Set ws2 = wb1.Worksheets("PO File Paths")
    Set tb1 = ws1.ListObjects("Table4711")
    Set tb2 = ws2.ListObjects("POHLINKCNV")
    Set rng1 = Range("Table4711[#All]")
    Set rng2 = Range("POHLINKCNV[#All]")
    Set rng3 = Range("POHLINKCNV[Full PO '#]")
    Set rng4 = Range("POHLINKCNV[Hyperlink]")
    Set rng5 = Range("Table4711[PO'#]")

'    rng5.Select
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    '    .CutCopyMode = False
    '    .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With

    Sheets("PO File Paths").Select
    
'    POFilePaths2024
    
    With Range("FilePathRange")
        .ClearFormats
        .ClearHyperlinks
    End With
    
    numRows = rng1.SpecialCells(xlCellTypeLastCell).Row - 1
    Set rng2 = rng2.Resize(numRows)
    tb2.Resize rng2
    
    With rng3
        .ClearContents
        .Formula2R1C1 = _
            "=IFERROR(IF(OFFSET(Table4711[@[PO'#]],1,0)=""""," & Chr(10) & """""," & Chr(10) & "OFFSET(Table4711[@[COMPL PO NO CORR]],1,0))," & Chr(10) & "OFFSET(Table4711[[#Headers],[COMPL PO NO CORR]],1,0))"
    End With
    
    rng4.ClearContents
    With rng4
        .ClearContents
        .FormulaR1C1 = "=IFERROR(VLOOKUP(""*""&IF(POHLINKCNV[@[Full PO '#]]="""","""",POHLINKCNV[@[Full PO '#]])&""*"",POFilePaths2024[PO File Paths - 2024],1,FALSE),"""")"
    End With
   
    With Range("FilePathRange")
        .Value = .Value
    End With
    
    For Each cl In rng4.Cells '## Modify as needed
        If cl <> "" Then
            cl.Hyperlinks.Add cl, cl.Value, , , cl.Offset(0, -1).Value
            cl = Right(cl, Len(cl) - 5)
        End If
        
        On Error Resume Next
        
        If cl = "" Then
            cl = cl.Offset(0, -1).Value
            cl = Right(cl, Len(cl) - 5)
        End If
    Next
    
    rng5.Copy
    rng4.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
    

    rng4.Copy
    rng5.PasteSpecial.Hyperlinks (1)
    
    IdentifyCellsWithHyperlink
    
    With Application
        .EnableEvents = True
    '    .ScreenUpdating = True
        .CutCopyMode = False
    '    .DisplayAlerts = False
        .Calculation = xlAutomatic
    End With

End Sub

 

[sspatriots]

The longer code below is one that I had found online and tried to tweak to work in my code. However, when I run this one I get the "Run-time error '5':" for "Invalid procedure call or argument". This error appears at the part:

        cell.Hyperlinks.Add _
            Anchor:=cell, _
            Address:=filePath, _
            TextToDisplay:=cell.Value ' Display the same text as in Column D

This is the code I was trying to make work instead of what is in my original post because I wasn't getting anywhere with it.

Sub TESTING_CreateHyperlinks()
    Dim wb1 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim tb1 As ListObject
    Dim rng1 As Range    
    Dim numRows As Long
    Dim i As Long

    Set wb1 = ThisWorkbook
    ' Set the worksheet where your data is located
    Set ws1 = wb1.Worksheets("2024")
    Set ws2 = wb1.Worksheets("PO File Paths")
    Set tb1 = ws1.ListObjects("Table4711")
    Set rng1 = Range("POHLINKCNV[Hyperlinks Sorted To Match PO BLK List]")

    ' Find the last row with data in Column A (file paths)
    numRows = tb1.ListRows.Count + 1

    ' Loop through each row and create hyperlinks
    For i = 3 To numRows ' Assuming data starts from row 2
        Dim filePath As String
        Dim cell As Range

        ' Get the file path from Column B in the worksheet called "PO File Paths"
        filePath = ws2.Cells(i, 2).Value

        ' Get the corresponding cell in Column D on the worksheet called "2024"
        Set cell = ws1.Cells(i, 4)

        ' Create the hyperlink
        cell.Hyperlinks.Add _
            Anchor:=cell, _
            Address:=filePath, _
            TextToDisplay:=cell.Value ' Display the same text as in Column D on the worksheet called "2024"
    Next i
End Sub

 

[sspatriots]

I'm posting the following in case anyone can use it. It is what I ended up using (after several hours of manipulation) to resolve my problems with the hyperlinks coming from another column in another table.

Here goes:

Sub CreatePOHyperlinks2024()

    Dim ws1 As Worksheet
    Dim FilePathColumn As Range
    Dim HyperlinkColumn As Range
    Dim FilePathPONOColumn As Range
    Dim Cell As Range
    Dim FilePath As String
    Dim FullPONO As Range
    
    Set ws1 = Worksheets("2024")
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .CutCopyMode = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    Call SetPOFilePathsInOrder2024

    ' Define the range used to sort PO file paths
    Set FilePathPONOColumn = Range("POHLINKCNV[Full PO '#]") ' Adjust range as needed
    
    ' Define the range for the column containing file paths
    Set FilePathColumn = Range("POHLINKCNV[File Paths Sorted To Match PO BLK List]") ' Adjust range as needed
    
    ' Define the range for the column where hyperlinks will be created
    Set HyperlinkColumn = Range("Table4711[PO'#]") ' Adjust range as needed
    
    HyperlinkColumn.ClearHyperlinks
    
    ws1.Activate
    Call IdentifyCellsWithHyperlink
    
    ' Loop through each cell in the FilePathColumn
    For Each Cell In FilePathColumn
        ' Get the file path from the current cell
        FilePath = Cell.Value2
        
        ' Check if the file path is not empty
        If FilePath <> "" Then
            ' Create hyperlink in the corresponding cell in the HyperlinkColumn
            HyperlinkColumn.Cells(Cell.Row - 2, 1).Hyperlinks.Add Anchor:=HyperlinkColumn.Cells(Cell.Row - 2, 1), _
            Address:=FilePath, TextToDisplay:=FilePath
        End If
    Next Cell
    
    HyperlinkColumn.Value2 = FilePathPONOColumn.Value2
   
    For Each FullPONO In HyperlinkColumn.Cells '## Modify as needed
        If FullPONO <> "" Then
            FullPONO = Right(FullPONO, Len(FullPONO) - 5)
        End If
    Next
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .CutCopyMode = False
        .DisplayAlerts = False
        .Calculation = xlAutomatic
    End With
   
End Sub