Efficient method to add hyperlink

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,303
Office Version
2016
Platform
Windows
Afternoon guys,

I'm trying to find an efficient method to add a hyperlink to a range of cells but what I have so far keeps generating an 'Out of memory' message. The code itself runs fine, but once it's complete I get the message. This is what I have so far:

Code:
LastImportRow = Sheet7.Range("A65000").End(xlUp).Row

For Each Cell In Sheet7.Range("D2:D" & LastImportRow)


On Error Resume Next
If Cell = 1 Then


LastRow = Sheet3.Range("A65000").End(xlUp).Row + 1
Sheet3.Range("B" & LastRow) = Cell.Offset(0, -2)
Sheet3.Range("G" & LastRow) = Cell.Offset(0, -3)


Path = "ds://" & Sheet3.Range("G" & LastRow).Value
ScreenTip = "Direct link"
TextToDisplay = Sheet3.Range("B" & LastRow)


Sheet3.Range("H" & LastRow).Select
Sheet3.Range("H" & LastRow).Hyperlinks.Add Anchor:=Selection, Address:=Path, ScreenTip:=ScreenTip, TextToDisplay:=TextToDisplay


End If
Next
I may be probably completely wrong, but is the issue that it's having to select each cell to add the hyperlink?

Is there a more efficient method to do this?
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,044
Office Version
365
Platform
Windows
( untested )
Try this in a COPY of your workbook

Code:
    Dim LastImportRow  As Long, LastRow As Long, Cell As Range, linkCell As Range, Path As String, TxtToDisplay As String
    Const ScreenTip = "Direct link"
    LastImportRow = Sheet7.Range("A65000").End(xlUp).Row
    Application.ScreenUpdating = False
    For Each Cell In Sheet7.Range("D2:D" & LastImportRow)
        On Error Resume Next
        If Cell = 1 Then
            LastRow = Sheet3.Range("A65000").End(xlUp).Row + 1
            Sheet3.Range("B" & LastRow) = Cell.Offset(0, -2)
            Sheet3.Range("G" & LastRow) = Cell.Offset(0, -3)
            Path = "ds://" & Sheet3.Range("G" & LastRow).Value
            TxtToDisplay = Sheet3.Range("B" & LastRow)
            Set linkCell = Sheet3.Range("H" & LastRow)
            linkCell.Hyperlinks.Add Anchor:=linkCell, Address:=Path, ScreenTip:=ScreenTip, TextToDisplay:=TxtToDisplay
        End If
        On Error GoTo 0
    Next Cell

:confused: Range("A65000").End(xlUp).Row :confused: Which version of Excel are you using ?
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,099,484
Messages
5,468,881
Members
406,618
Latest member
SAMEERS

This Week's Hot Topics

Top