CODEWITHSUNDEEP
excelvba
PsyduckDebugging
PsyduckDebugging

Reputation: 19

VBA losing links

Manual - Select range, execute Sub

How it works - Sub saves all non-blank cells to finalArray that is ultimately displayed in the selected range

What's the problem - if range contains cells with hyperlinks created via insert-hyperlink, the hyperlinks disappear.

Sub RemoveBlanks()
'i,j - counters,  k - offset

Dim finalArray() As Variant
ReDim finalArray(Selection.Rows.Count, 1)
k = 1

For i = 1 To Selection.Rows.Count
    If Selection(i, 1) <> "" Then
    finalArray(k, 1) = Selection(i, 1)
        k = k + 1
    End If
Next i

Application.ScreenUpdating = False
Application.EnableEvents = False
Selection.Clear

For i = 1 To k
    Selection(i, 1).Value = finalArray(i, 1)
Next i

End Sub

Upvotes: 0

Views: 182

Answers (2)

PsyduckDebugging
PsyduckDebugging

Reputation: 19

So I have found a way around the issue after lurking through internet and trying to save links in another array (fails). It works only if the value in the cell is the same as name of a sheet, yet it solves my issue so far.

Sub CreateLinks()
'i - counter, the title as i=1 is omitted. Code uses value stored in cell to 
 'transform it into a link. 
Dim i As Integer
For i = 2 To Selection.Rows.Count
    If Selection(i) <> "" Then
    ActiveSheet.Hyperlinks.Add anchor:=Selection(i), _
                               address:="#'" & CStr(Selection(i)) & "'!A1", _
                               TextToDisplay:=CStr(Selection(i))
    End If
Next i
End Sub

Upvotes: 0

TourEiffel
TourEiffel

Reputation: 4414

This Code will loops through each cell in the selected range, checks if the cell has a hyperlink then temporarily grab and store the address that it’s pointing to re-apply the hyperlink

Option Explicit

Sub fixHyperlinks()
    Dim rng As Range
    Dim address As String

    Application.ScreenUpdating = False

    For Each rng In Selection
        If rng.Hyperlinks.Count > 0 Then
            address = rng.Hyperlinks(rng.Hyperlinks.Count).address  

            rng.Hyperlinks.Add Anchor:=rng, _
                               address:=address  
        End If
    Next

    Application.ScreenUpdating = True
End Sub

After you run this code, you should be able to set in your array the range without losing your links.

Conclusion : Run this code before you run your macro.

Upvotes: 0

Related Questions