VBA to list all links (external links AND hyperlinks) together with the cells containing the links

Hello,

I need to use VBA to list all links (both external links AND hyperlinks) in a workbook and have the location of the corresponding cells that contain these links listed beside them for reference. I do have the code (see Table 1: Code at the bottom of this post) to pull the cell reference for external links from this thread here:

VBA to list all external links together with the cells containing the links

However, the VBA does not also find hyperlinks. I need it to go one more step further to also give me the location of hyperlinks as well.

Here is an example sheet where I want to extract all links (not just external links but also hyperlinks)



However, when I run the macro in 'Table 1: Code', I only get this output



In other words, this macro is not also detecting the hyperlink to youtube in cell B3 of 'Sheet 1'. Can you help me improve this macro to also detect hyperlinks?

Your help is greatly appreciated.
Jay


Table 1: Code
Option Explicit

Sub ListLinks()

Dim Wks As Worksheet
Dim rFormulas As Range
Dim rCell As Range
Dim aLinks() As String
Dim Cnt As Long

If ActiveWorkbook Is Nothing Then Exit Sub

Cnt = 0
For Each Wks In Worksheets
On Error Resume Next
Set rFormulas = Wks.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rFormulas Is Nothing Then
For Each rCell In rFormulas
If InStr(1, rCell.Formula, "[") > 0 Then
Cnt = Cnt + 1
ReDim Preserve aLinks(1 To 2, 1 To Cnt)
aLinks(1, Cnt) = rCell.Address(, , , True)
aLinks(2, Cnt) = "'" & rCell.Formula
End If
Next rCell
End If
Next Wks

If Cnt > 0 Then
Worksheets.Add before:=Worksheets(1)
Range("A1").Resize(, 2).Value = Array("Location", "Reference")
Range("A2").Resize(UBound(aLinks, 2), UBound(aLinks, 1)).Value = Application.Transpose(aLinks)
Columns("A:B").AutoFit
Else
MsgBox "No links were found within the active workbook.", vbInformation
End If

End Sub