PDA

View Full Version : [SOLVED] 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?

:dunno

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).

Anne Troy
05-25-2004, 04:08 PM
LOL!

I'm hoping for this to be a future KB contribution. I can't have hard-coded cells! Hee hee. Sorry. I shoulda said so, Zack. :)

Let's suppose that I want all cells from A2 and down the used range of column A.

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?

Anne Troy
05-25-2004, 04:31 PM
I thought you had kids? :p


Okay...bad, bad me.

WORKED GREAT!!

Zack Barresse
05-25-2004, 04:33 PM
Okay...bad, bad me.

damn straight... :*)

Mark O'Brien
05-25-2004, 08:41 PM
How about this for being more generic?

The benefit of this method is that neither range is hard-coded.


Public Sub example()
'This subroutine acts as an example of how to use the "target" subroutine
Dim oRange As Range
Dim oTarget As Range
Set oRange = Range("A2", Range("A65536").End(xlUp))
Set oTarget = oRange.Offset(0, 1)
transfer oRange, oTarget
End Sub
Private Sub transfer(ByRef rng As Range, ByRef Target As Range)
'This is the actual solution to the post
rng.Copy
Target.PasteSpecial (xlPasteAll)
With rng
.Hyperlinks.Delete
End With
Application.CutCopyMode = False
End Sub

TonyJollans
05-26-2004, 02:12 AM
I think the 'problem' needs a bit more definition. Originally it was column A to column B; now it's variable (User-supplied) ranges - big difference :) .

Is this to run from the User Interface - in other words is the User going to specify the source range - by selection, let's say, before clicking a button. And if so, how is the user going to specify the target, or should it always be the column to the right - or a new column? What if the source range is multicolumn - should new columns (if wanted) be added as a block, or interleaved? If a single column goes to the column on the right, should, say, a single row selection go to the row BELOW?

What should happen to non-hyperlink data in the source range? What should happen to existing data in a (User-selected) target range?

I do think it's reasonable to insist on a single contiguous range.

Ignoring selections for a minute, one point about all the code offered so far is that it doesn't separate out the hyperlinks from the friendly names which seems to be what was asked for. I think this requires spinning through the Hyperlinks Collection.

Anne Troy
05-26-2004, 05:33 AM
Well, let's define it then.

What would be the best if someone asked the question the way I did? What code is going to be the easiest to use and implement for the average person (who usually knows NO VBA).

Mark O'Brien
05-26-2004, 06:17 AM
Public Sub main()
Dim oRange As Range
'The rest of this code will be green.
'and formatting not preserved.
'(most notably when you edit the post)
MsgBox "hi"
Set oRange = ActiveSheet.Range("A1")
End Sub



Edit by mark007: hmm, I saw a post like this before and when I went to edit it it looked fine then when I saved changes it looked fine. I'm not sure what the issue is. Does it happen everytime you post?

EDIT:: OS is Win2K. Yes, when I editted the post previously it jacked up the spacing, but now it seems to work.

BTW, for clarity it's probably better to reply to a post like this rather than to edit it.

mark007
05-26-2004, 06:27 AM
In a stab in the dark - what OS/browser are you using?

If you edit it again will it revert to all green?

:)

XL-Dennis
05-26-2004, 06:41 AM
What code is going to be the easiest to use and implement for the average person.
I always try to target the KISS-concept:
Keep it simple, stupid (for the end-users)

An add-in that is automatically activated upon installation
where the function is available via a toolbar button and/or menu-option and
where the end-users select the source-range (before hitting the button)
and then via a small inputbox select the first target-cell.

Based on this approach we can start to write the code as we have located the functionality and a userfriendly interface.

Do we have green light?
Dennis

TonyJollans
05-26-2004, 07:32 AM
Dennis,

I agree 100% - if it ain't simple to use it won't get used.

I'll go with your definition. And ..

.. overwrite cells in target range
.. copy non-hyperlinks in range unchanged?
.. disallow overlapping ranges?

Anybody else?

Anne Troy
05-26-2004, 07:34 AM
I just want to say...I have never seen so many experts working together, and really discussing the issues. This is too cool. The neat thing is that the outcome is as good as it can be, and our KB will be so *&^%$## sweet!!!

XL-Dennis
05-26-2004, 09:50 AM
Tony,

I?m with You - :thumb

Kind regards
Dennis

Zack Barresse
05-26-2004, 10:05 AM
Tony,

I?m with You - :thumb

Kind regards
Dennis
ditto - Dennis

Mark O'Brien
05-26-2004, 11:00 AM
I guess I'm following the UI discussion here. I editted firefytr's code with a suggestion to make the subroutine generic, I was not trying to address the initial problem:



Private Sub transfer(ByRef rng As Range, ByRef Target As Range)
'This is the actual solution to the post
rng.Copy
Target.PasteSpecial (xlPasteAll)
With rng
.Hyperlinks.Delete
End With
Application.CutCopyMode = False
End Sub


You can copy this code in anywhere and call it from a main subroutine. The GUI doesn't matter as much as the code interface. The subroutine as I posted becomes an encapsulated, standalone routine. You pass two ranges and the routine does the rest.

I provided an example subroutine as to how you could use it. I don't think it really matters howthe GUI is set up since that just creates more overhead on the forum. i.e. it doesn't matter if the OP wants to create an add-in or a userform or use a intputbox to get the ranges. If the OP needs that help, then they will ask.

Or am I missing something here? :dunno

Anne Troy
05-26-2004, 11:08 AM
more overhead on the forum

I saw this question posted elsewhere, and wished we had it as a contribution at www.vbaexpress.com/kb (http://www.vbaexpress.com/kb), which is the primary purpose of this site, and will be implemented as soon as we have a submission form.

I wanted this thread to result in a contribution by whoever...
All we need to do is handle, say, any range in col A gets dumped over to the adjacent cells in B. Yes, it'd be nice if it can be in ANY col and get dumped over to the next column to the right.

User interface is unnecessary at this point since it's not an addin or anything like that. However, is this something we should add to the World Tag Excel Addin?

I can't test the code because I can't run it. If we're going to add it to the KB, then we need those instructions. I'm sure YOU all know how, but me don't!

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

Anne Troy
05-27-2004, 03:14 AM
Well, well, well - I didn't tag my second piece of 'code' but the system identified it as VBA - very clever!
Not exactly...
A little birdie happened to see it...
:type

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 - :thumb

Kind regards,
Dennis

Mark O'Brien
05-27-2004, 06:00 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.

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.

Anne Troy
05-27-2004, 06:08 AM
This code, intended for the KB, would be utilitarian: once and done, most likely.
It would be cool if the person didn't have to choose the range, but merely only needed to ensure that wherever their hyperlinks reside, then the cell to the right is blank and can be populated with the hyperlinks.

I don't think we need to get into a big deal with a typical KB entry like this.

However! Were we to implement this feature into the addin...that's a different story!

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 :thumb

Kind regards,
Dennis

Anne Troy
05-27-2004, 06:47 AM
But not here, Den. Can we take this discussion where it belongs?

http://www.vbaexpress.com/forum/showthread.php?t=66

:D

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