Extract hyperlinks
A few weeks ago I got a question about hyperlinks. A list of soccer clubs was kept in Excel (4000+). Some of them had a hyperlink some didn't.
How to see this quickly? A possible solution is to show them in different colors:
Private Sub ColorHyperlinks()
' color cells with hyperlinks
Dim rngCel As Range
Application.ScreenUpdating = False
For Each rngCel In Selection
If rngCel.Hyperlinks.Count <> 0 Then
' cell has a hyperlink make yellow (6)
rngCel.Interior.ColorIndex = 6
Else
' remove color: -4142
rngCel.Interior.ColorIndex = -4142
End If
Next rngCel
Application.ScreenUpdating = True
End Sub
' color cells with hyperlinks
Dim rngCel As Range
Application.ScreenUpdating = False
For Each rngCel In Selection
If rngCel.Hyperlinks.Count <> 0 Then
' cell has a hyperlink make yellow (6)
rngCel.Interior.ColorIndex = 6
Else
' remove color: -4142
rngCel.Interior.ColorIndex = -4142
End If
Next rngCel
Application.ScreenUpdating = True
End Sub
Or you can make the cells with hyperlinks bold:
Private Sub BoldHyperlinks()
' makes cells with hyperlink bold
Dim rngCel As Range
Application.ScreenUpdating = False
For Each rngCel In Selection
If rngCel.Hyperlinks.Count <> 0 Then
' make bold:
rngCel.Font.Bold = True
Else
' Not Bold
rngCel.Font.Bold = False
End If
Next rngCel
Application.ScreenUpdating = True
End Sub
' makes cells with hyperlink bold
Dim rngCel As Range
Application.ScreenUpdating = False
For Each rngCel In Selection
If rngCel.Hyperlinks.Count <> 0 Then
' make bold:
rngCel.Font.Bold = True
Else
' Not Bold
rngCel.Font.Bold = False
End If
Next rngCel
Application.ScreenUpdating = True
End Sub
In the next version of ASAP Utilities I'll build in a function to extract the hyperlinks:
Private Sub ExtractHyperlinks()
' extracts hyperlink and put it in the next column
Dim rngCel As Range
Application.ScreenUpdating = False
For Each rngCel In Selection
If rngCel.Hyperlinks.Count <> 0 Then
' cell has a hyperlink:
rngCel.Offset(0, 1).Value = rngCel.Hyperlinks(1).Address
End If
Next rngCel
Application.ScreenUpdating = True
End Sub
' extracts hyperlink and put it in the next column
Dim rngCel As Range
Application.ScreenUpdating = False
For Each rngCel In Selection
If rngCel.Hyperlinks.Count <> 0 Then
' cell has a hyperlink:
rngCel.Offset(0, 1).Value = rngCel.Hyperlinks(1).Address
End If
Next rngCel
Application.ScreenUpdating = True
End Sub
Filed under: ASAP Utilities, General on September 19th, 2005 by Bastien |
Hi,
Thanks a lot for your GREAT utilities!
Extract hyperlinks works nicely with text but it does not work if I want to extract hyperlinks from images. You know when you copy table from web there are sometimes links on pictures/buttons.
Could you please make that option possible also.
Many thanks in advance,
Ants
I am really thankful to Bastien who solved the “extract hyperlinks from images” issue in TWO DAYS and added the feature to new version of ASAP utilities.
Highly recommended utilities and support is lightning-fast!
Best regrds,
Ants
extracts hyperlink and put it in the next column
this is exacly what i need, what do i do? I made a new module and inserted the code, whats the next step?
Hello Francisco,
Select the cells that you need to be “visualized” and then run the code.
Kind regards,
Bastien
You are great. Saved me a lot of time!