VBA losing links - excel

Question

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

Answer 1

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.

Answer 2

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