Get Underlying Hyperlinks Out of Friendly Names

**Anne Troy** · 05-25-2004, 03:50 PM

Column A contains hyperlinks underneath other text.
How can I pull the hyperlinks into column B?

And then, what if I also wanted to trash the underlying hyperlinks in Column A?

**Zack Barresse** · 05-25-2004, 03:58 PM

maybe something like this??...

Sub transfer()
Dim rng As Range
    Set rng = Range("A1:A10")
    rng.Copy
    Range("B1:B10").PasteSpecial (xlPasteAll)
    With rng
    .Hyperlinks.Delete
    End With
End Sub

change ranges to suit. (if i understood correctly).

**Zack Barresse** · 05-25-2004, 04:15 PM

ok, how about this:

Sub transfer()
Dim rng As Range
    Set rng = Range("A2", Range("A2").End(xlDown))
    rng.Copy
    rng.Offset(0, 1).PasteSpecial (xlPasteAll)
    With rng
    .Hyperlinks.Delete
    End With
    Application.CutCopyMode = False
End Sub

better?

or will there possibly be non-contiguous ranges wanted with this? if so, how about:

Sub transfer()
Dim rng As Range
    Set rng = Range("A2", Range("A65536").End(xlUp))
    rng.Copy
    rng.Offset(0, 1).PasteSpecial (xlPasteAll)
    With rng
    .Hyperlinks.Delete
    End With
    Application.CutCopyMode = False
End Sub

this better? or am i shootin blanks here?

**Zack Barresse** · 05-25-2004, 04:33 PM

Originally Posted by Dreamboat

Okay...bad, bad me.

damn straight...

**TonyJollans** · 05-27-2004, 02:41 AM

Yes, Mark, the UI and the functionality are different beasts - it was Anne's second post that I thought brought the UI into scope, and there is probably a bigger issue here to do with run instructions.

If I were an ignorant user (some say I am, of course

) how could I take a KB solution and use it? Posting detailed instructions with every piece of code is way over the top; should there be some generic instructions somewhere so that, in an individual case it's sufficient to say something like - paste this code into a standard code module (or ThisWorkbook, or wherever), close the VBA, etc. - which can then be referred to?

Anyway, in this instance, none of the code posted so far has separated out the underlying hyperlinks, so here's some code which does ..

Private Sub transfer(ByRef rng As Range, ByRef Target As Range)
Dim h As Hyperlink
rng.Copy
Target.PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
With rng
    .Hyperlinks.Delete
End With
For Each h In Target.Hyperlinks
    h.TextToDisplay = h.Address & IIf(h.SubAddress = "", "", IIf(h.Address = "", "", " - ") & h.SubAddress)
Next
End Sub

This could be used with something like ..

Sub TestIt()
' Get SourecRange from User
' Get TargetRange from User
transfer SourceRange, TargetRange
End Sub

where Getting the ranges from the User are (probably) other KB code routines.

**TonyJollans** · 05-27-2004, 02:54 AM

Well, well, well - I didn't tag my second piece of 'code' but the system identified it as VBA - very clever!

**XL-Dennis** · 05-27-2004, 03:10 AM

Hi all :hi

Unlike other boards I like to see that we also include error-handling in the provided solutions, especially when they are supposed to be used by less skilled user.

Therefore I made the following add-ons:

Option Explicit
Sub Do_It()
Dim rnSource As Range, rnStart As Range, rnTarget as Range
If ActiveSheet.ProtectContents = False Then
    If TypeName(Selection) = "Range" Then
        With Selection
            If .Columns.Count <> 1 Then
                MsgBox "Please make sure that the selection only contains one column.", vbInformation
                GoTo ExitHere
            ElseIf .Areas.Count <> 1 Then
                MsgBox "Please make sure that the selection only covers one area.", vbInformation
                GoTo ExitHere
            Else
                Set rnSource = Selection
            End If
        End With
    Else
        MsgBox "You need to select a range before executing this procedure.", vbExclamation
        GoTo ExitHere
    End If
Else
    MsgBox "You need to unprotect the worksheet before executing this procedure.", vbExclamation
    GoTo ExitHere
End If
On Error Resume Next
Set rnStart = Application.InputBox( _
Prompt:="Please select the first cell in the target range:", _
Title:="Select targetrange", _
Type:=8)
On Error GoTo 0
If rnStart Is Nothing Then
    GoTo ExitHere
Else
    Set rnTarget = rnStart.Resize(rnSource.Rows.Count, 1)
    Transfer rnSource, rnTarget
End If
ExitHere:
Exit Sub
End Sub

Private Sub Transfer(ByRef rng As Range, ByRef Target As Range)
Application.ScreenUpdating = False
rng.Copy
Target.PasteSpecial (xlPasteAll)
With rng
    .Hyperlinks.Delete
End With
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With
End Sub

Kind regards,
Dennis

**Mark O'Brien** · 05-27-2004, 06:00 AM

Originally Posted by TonyJollans

Yes, Mark, the UI and the functionality are different beasts - it was Anne's second post that I thought brought the UI into scope, and there is probably a bigger issue here to do with run instructions.

Huh? Are you referring to the bit where Anne says she doesn't want the range hard-coded?

I guess I agree with the last two comments from Tony and Dennis about environment and error trapping, but really, it all seems like overkill for a relatively simple post. Perhaps an example of these techniques in the KB would be easier to simply refer to than to answer every question with 30 lines of code.

**TonyJollans** · 05-27-2004, 03:39 AM

I like the idea of always having full error handling, but it's going to put a load on the approvers.

BTW, you need rnTarget As Range

**XL-Dennis** · 05-27-2004, 04:08 AM

Tony,

Thanks for the heads up - I added it in the original post

Yes, I agree but I believe it should only be necessary for the KB-articles.

Kind regards,
Dennis

**TonyJollans** · 05-27-2004, 04:21 AM

In my book a procedure should never make incidental changes to the environment. I know this is not always possible in VBA, but with ScreenUpdating, I think your example should have ..

Private Sub Transfer(ByRef rng As Range, ByRef Target As Range) 
Dim CallerScreenUpdating as boolean
        CallerScreenUpdating = Application.ScreenUpdating
        Application.ScreenUpdating = False 
' rest of code 
Application.ScreenUpdating = CallerScreenUpdating 
End Sub

Without this, the caller may have set it False only to find it True after calling a sub-routine which he wouldn't want.

**XL-Dennis** · 05-27-2004, 04:34 AM

G8 -

Kind regards,
Dennis

**XL-Dennis** · 05-27-2004, 06:44 AM

it all seems like overkill for a relatively simple post

Yupp, but I like to see where we stand when it comes to some aspects for the KB-articles. A general write-up about error-handling is great but as I said I like to see some stuff different here.

So let the comments come about it

Kind regards,
Dennis

**roos01** · 06-18-2004, 11:24 AM

Hi Dreamboat,
here another approach. If I read the question correctly then you want to have the hyperlink address in column B. Hereby I asume that the cell contains a value which is shown like "test". Underlying there is a link towards http://www.test.com. This last value you want to see in column B. IN this case you might think about using a macro like:

Sub HyperlinkAddr()
Application.ScreenUpdating = False
rowsA = Cells(Rows.Count, 1).End(xlUp).row
For i = 1 To rowsA
    If Cells(i, 1).Hyperlinks.Count > 0 Then
        Cells(i, 1).Offset(0, 1).value = Cells(i, 1).Hyperlinks(1).Address
    End If
Next i
Application.ScreenUpdating = True
End Sub

I hope this is what you needed.

regards,
Jeroen

Thread: Get Underlying Hyperlinks Out of Friendly Names

Thread Tools

Display

Hybrid View

Get Underlying Hyperlinks Out of Friendly Names

Posting Permissions