• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copying a Cell which contains a Hyperlink to another Worksheet

Jabba1963

Member
I've checked out Chandoo's extensive summary on Hyperlinks but still getting myself in a pickle... !!


Found this out there out there on the net... courtesy of someone called Webtest

[pre]
Code:
Sub HyperlinkMoveTest()
Dim aSheet As Worksheet 'Sheet Handle
Dim hLink As Hyperlink  'Hyperlink Handle
Dim rngDst As Range     'Destination Cell
Dim rngSrc As Range     'Source Cell

'Set a Handle for the working Sheet
Set aSheet = ActiveWorkbook.Sheets("TEST")
'Iterate through all the Hyperlinks in a range
For Each hLink In aSheet.Range("B1:B18").Hyperlinks
'Fetch the cell address of the source Hyperlink
Set rngSrc = hLink.Range
'Set the Destination Cell address based on the Source Cell address
Set rngDst = rngSrc.Offset(0, 2)
'Load the Destination Cell with the Hyperlink WITHOUT AFFECTING THE FORMAT !!!
aSheet.Hyperlinks.Add rngDst, hLink.Address, , , hLink.Range.Text
Next hLink
End Sub
[/pre]

I like this because it retains the format in the destination cell.


Tried adapting this to suit my needs... but failing miserably... what I would like, is to be able to pass a cell range (single cell or more) and destination range into the routine independent of being on the same worksheet - the above uses the offset and hence only works when the source and destination are on the same worksheet ie. copy the contents of wsSrc!B3 to wsDst!E7 irrespective of whether wsSRc and wsDst are the same worksheets or not.


eg. CopyHyperlink("AWorksheet!B3", "AnotherWorksheet!E7") whilst retaining the format of the destination cell


Any assistance gratefully received

Thanks
 
Hi Jabba,

Can I ask what is your Basic Requirement:

* Only copy format + Hyerlink for the cell which contain Hyperlink or

* Copy irrespective to Hyperlink is true / false, Code need to copy exact range's format + if(hyperlink)


Regards,

Deb
 
Hi Deb and thanks for the speedy response...


I have a specific task in mind... so in my case the cells in question will contain a hyperlink... but appreciate there is all manner of additional checking that can be brought into play...
 
Hi Jabba,


Can you please try the below code..

[pre]
Code:
Sub CopyAll()
Dim source As Range, destination As Range
Set source = Application.InputBox("Select Source Range", "Source", "Sheet1!A1:B10", Type:=8)
Set destination = Application.InputBox("Select Destination CELL", "Destination", "Sheet2!D1", Type:=8)
Dim alRW As Long, alCL As Long, i As Long, j As Long
alRW = source.Rows.Count
alCL = source.Columns.Count
Dim temp As Range
For i = 1 To alRW
For j = 1 To alCL
source.Cells(i, j).Copy destination.Cells(i, j)
Next j
Next i
Next k
End Sub
[/pre]
Run the Macro, It will ask you for Source Range and Destination Range. Just Select the area you need to copy, and in next step, select Destination Area where need to paste.


Please let us know if it works for you..


Regards,

Deb


PS: Not for multiple Areas..
 
Hi Deb


It copies however... it loses the format of the destination cell which the routine I started with wasn't doing so... and this is essential...


Secondly... the process will all take place within another vba routine... which is not expecting user interaction so I need to avoid inputboxes...


Hence I was looking for something like this...


eg. CopyHyperlink("AWorksheet!B3", "AnotherWorksheet!E7")


Sorry to be pain - cos I appreciate the input...


Regards

Jabba
 
Hi Jabba,


Sorry to say, I still not able to got it properly.

* First thing Clear - You want to retain Format..

* Do you want to retain Value in Destination Also or you want destination's value need to be change to source Value...


BTW, for the time being look at the below code

[pre]
Code:
Sub CopyHyperlinkOnly(source As Range, destination As Range)
'    Dim source As Range, destination As Range
'    Set source = Application.InputBox("Select Source Range", "Source", "Sheet1!A1:B10", Type:=8)
'    Set destination = Application.InputBox("Select Destination CELL", "Destination", "Sheet2!D1", Type:=8)
Dim alRW As Long, alCL As Long, i As Long, j As Long
alRW = source.Rows.Count
alCL = source.Columns.Count
Dim temp As Range
For i = 1 To alRW
For j = 1 To alCL
If source.Cells(i, j).Hyperlinks.Count Then
destination.Cells(i, j).Hyperlinks.Add destination.Cells(i, j), source.Cells(i, j).Hyperlinks(1).Address
End If
Next j
Next i
End Sub
[/pre]
Sub CallFromOutside()

Call CopyHyperlinkOnly([AWorksheet!b3], [AnotherWorksheet!E7])

End Sub


Regards,

Deb


PS: If you want to select at runtime, delete the comments and delete the parameters from the CopyHyperlinkOnly..
 
Heh Deb


Thanks again for your assistance on this...


Just in passing - my VBA is self taught and I whilst I have been using VBA extensively for some time I still struggle with the concept of methods, objects, etc... so I fully intend to do something about that and get a grip of these concepts in due course...


Meanwhile - I went with the runtime option because I was struggling to pass a range - see what I mean about concepts - lol.


Your code again works however the destination cell still loses its previous formatting... and given your questions... I will try and clarify what I am trying to do.


I have a sheet1 which is essentially a report I am going to email... and/or print out all formatted and ready to go.


I have another sheet2 which has cells which contain text headlines from news articles but are themselves hyperlinks to the internet address from which the headlines come from. I have extracted the links from an email in Outlook from Google Alerts and pulled the details into Excel.


At the press of button I want to pull the cells (text + hyperlink) from sheet2 across into sheet1... but not into the equivalent cell reference... so a "for loop" on i and j is probably not the best approach... AND retain the format of the sheet1 so that I can then print/email it directly. I could simply reformat but when I found and tested the code I posted earlier I realised there was no requirement to do this.


So for example...


Worksheet 2

E1 - contains a hyperlink to "www.thetimes.com/shwgqoiio3jqoggh"

- displays "Hollywood Scandal of huge magnitude..."

E2 - contains a hyperlink to "www.anothernewspaper.com/s34634436hwgqogwgweiio3jqoggh"

- displays "Massive storm coming from the East..."

E3 etc....


Press the button and...


Worksheet 1

O8 - contains a hyperlink to "www.thetimes.com/shwgqoiio3jqoggh"

- displays "Hollywood Scandal of huge magnitude..."

M3 - contains a hyperlink to "www.anothernewspaper.com/s34634436hwgqogwgweiio3jqoggh"

- displays "Massive storm coming from the East..."

G5 etc....


And all formatting in sheet 1 is retained...


Note how source cells E1,E2,E3,E4 goes to destination cells O5, F7, G3 - ie. totally arbitary and random due to the layout of the report/sheet 1.


I tried revamping the original code as follows:

[pre]
Code:
Sub vvvHyperlinkMoveTest()

Dim aSheet As Worksheet 'Sheet Handle
Dim bSheet As Worksheet 'Sheet Handle
Dim hLink As Hyperlink  'Hyperlink Handle
Dim rngDst As Range     'Destination Cell
Dim rngSrc As Range     'Source Cell

Set aSheet = ActiveWorkbook.Sheets("GoogleAlerts")
Set bSheet = ActiveWorkbook.Sheets("DailyNews")

For Each hLink In aSheet.Range("E1").Hyperlinks

Set rngSrc = hLink.Range

Set rngDst = bSheet.Range("O8")

aSheet.Hyperlinks.Add rngDst, hLink.Address, , , hLink.Range.Text

Next hLink

End Sub
[/pre]

And whilst it works it seems it does not retain neither the source or the destination format... so I am beginning to suspect the original code does not retain format (whether it takes the source with it or leaves the destination format) at all.


So happy to forget about retaining the formatting and I will set up a macro to re-format accordingly...


Sorry to have waffled on but hope that clarifies everything...


Regards and thanks again

Jabba


btw. nice touch with putting the runtime option in comments - I'll remember that one :)
 
Back
Top