How to overcome the limit of hyperlinks in Excel?

Question

I have a list of links in more than 100000 cells.

I have to give hyperlinks to all of them but in Excel there is a limit of 65530 hyperlinks per worksheet.

How can I overcome the limit or how can I merge cells with equal values using VBA?

Sub AddHyperlinks()

    Dim myRange As Range
    Set myRange = Range("A1")
    Dim hText As Variant

    Do Until IsEmpty(myRange)

        hText = Application.VLookup(myRange.Value, Worksheets("Sheet2").Range("A:B"), 2, False)

        If IsError(hText) Then
            hText = ""
        Else
            ActiveSheet.Hyperlinks.Add Anchor:=myRange, Address:="http://" + hText, TextToDisplay:=myRange.Text
            hText = ""
        End If

        Set myRange = myRange.Offset(1, 0)
    Loop

End Sub

Answer 1

The solution is as mentioned by @Rory: Use the HYPERLINK function in your cell to emulate a hyperlink via a formula.

=HYPERLINK(url, displaytext)

This effectively bypasses the built-in Excel limit on "hard-coded" hyperlinks. Just tested this out after I hit the infamous error 1004:

Application-defined or object-defined error

when trying to create 100k+ hyperlinks in a sheet.

Answer 2

Just regular copy paste should work, but I can update the example (not tested) if it doesn't

Sub AddHyperlinks() 

    Dim rng As Range, rngFrom As Range, values, r
    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")
    Set rngFrom = ThisWorkbook.Worksheets("Sheet2").Range("A:A")

    rng.Worksheet.Hyperlinks.Delete   ' remove all previous Hyperlinks

    While rng(1) > ""

        ' resize the range to the same values
        While rng(rng.Rows.Count + 1) = rng(1)
            Set rng = rng.Resize(rng.Rows.Count + 1)
        Wend

        r = Application.Match(rng(1), rngFrom, 0)    
        If Not IsError(r) Then
            values = rng.Value2    ' save the values 
            rngFrom(r, 2).Copy rng ' copy from the cell next to the match
            rng.Value2 = values    ' restore the values (not sure if it removes the links) 
        End If

        Set rng = rng(rng.Rows.Count + 1) ' move to the next cell below
    Wend

End Sub