Efficient method to add hyperlink

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,340
Office Version
  1. 2016
Platform
  1. 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?
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. 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,133,459
Messages
5,658,893
Members
418,475
Latest member
ExcelBeginner233

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top