Copy Hyperlinks to other cells
Hi Joe
How do I check in the debugger what the value of lHyperlink.Range.Row is
I'm still learning
Sub HyperList()
Set lHyperLinkList = CreateObject("Scripting.Dictionary")
Set lSheetORG = ThisWorkbook.Sheets("sheet1")
Set lSheetOUT = ThisWorkbook.Sheets("sheet2")
For Each lHyperlink In lSheetORG.Hyperlinks
"yellow arrow here" Call lHyperLinkList.Add("C" & lHyperlink.Range.Row,
lHyperlink.Address)
Next lHyperlink
lSheetOUT.Hyperlinks.Delete
lKeys = lHyperLinkList.keys
lItems = lHyperLinkList.items
For i = 0 To lHyperLinkList.Count - 1
Set lRange = lSheetOUT.Range(lKeys(i))
lSheetOUT.Hyperlinks.Add Anchor:=lRange, Address:=lItems(i),
TextToDisplay:=lRange.Value
Next i
End Sub
I have tried
'Set lHyperLinkList = CreateObject("Scripting.Dictionary")
Thanks Joe
Dave
"Joe HM" wrote in message
oups.com...
Hello -
Did you check in the debugger what the value of lHyperlink.Range.Row
is?
You really don't need to use the Script.Dictionary but can copy over
the hyperlinks directly. I just had to do it for another reason.
Joe
On Aug 3, 11:14 am, "DaveM" wrote:
Hi Joe
Sub HyperList()
Set lHyperLinkList = CreateObject("Scripting.Dictionary")
Set lSheetORG = ThisWorkbook.Sheets("sheet1")
Set lSheetOUT = ThisWorkbook.Sheets("sheet2")
For Each lHyperlink In lSheetORG.Hyperlinks
"when run I get yellow arrow in VBE here on this line" Call
lHyperLinkList.Add("C" & lHyperlink.Range.Row, lHyperlink.Address)
Next lHyperlink
lSheetOUT.Hyperlinks.Delete
lKeys = lHyperLinkList.keys
lItems = lHyperLinkList.items
For i = 0 To lHyperLinkList.Count - 1
Set lRange = lSheetOUT.Range(lKeys(i))
lSheetOUT.Hyperlinks.Add Anchor:=lRange, Address:=lItems(i),
TextToDisplay:=lRange.Value
Next i
End Sub
Thanks
Dave
"Joe HM" wrote in message
oups.com...
Hello -
I tweaked the code you sent in your last message. You just need to
rename SOURCE and TARGET to whatever the worksheets are called (i.e.
the names of their tabs).
Sub HyperList()
Set lHyperLinkList = CreateObject("Scripting.Dictionary")
Set lSheetORG = ThisWorkbook.Sheets("SOURCE")
Set lSheetOUT = ThisWorkbook.Sheets("TARGET")
For Each lHyperlink In lSheetORG.Hyperlinks
Call lHyperLinkList.Add("C" & lHyperlink.Range.Row,
lHyperlink.Address)
Next lHyperlink
lSheetOUT.Hyperlinks.Delete
lKeys = lHyperLinkList.keys
lItems = lHyperLinkList.items
For i = 0 To lHyperLinkList.Count - 1
Set lRange = lSheetOUT.Range(lKeys(i))
lSheetOUT.Hyperlinks.Add Anchor:=lRange, Address:=lItems(i),
TextToDisplay:=lRange.Value
Next i
End Sub
Joe
On Aug 3, 10:34 am, "DaveM" wrote:
Hi Joe
I have renamed my sheets same as yours, This is what I have in VBE
'You can use the following to do that. Please note that I store the
'hyperlinks in a Scripting.Dictionary for some other reasons. You
'might not have to do that. lSheetORG is the original Worksheet and
'lSheetOUT is the target Worksheet.
Sub HyperList()
Set lHyperLinkList = CreateObject("Scripting.Dictionary")
'Set lSheet = ThisWorkbook.Sheets("lSheetORG")
For Each lHyperlink In lSheetORG.Hyperlinks
Call lHyperLinkList.Add("C" & lHyperlink.Range.Row,
lHyperlink.Address)
Next lHyperlink
lSheetOUT.Hyperlinks.Delete
lKeys = lHyperLinkList.keys
lItems = lHyperLinkList.items
For i = 0 To lHyperLinkList.Count - 1
Set lRange = lSheetOUT.Range(lKeys(i))
lSheetOUT.Hyperlinks.Add Anchor:=lRange, Address:=lItems(i),
TextToDisplay:=lRange.Value
Next i
End Sub
Thanks
Dave
"Joe HM" wrote in message
roups.com...
Hello Dave -
This is strange ... works just fine for me and that on a sheet
without
any hyperlinks.
Do you have a Sheet1?
Did you try to create something like ...
Set lSheet = ThisWorkbook.Sheets("NAME")
... and use that?
Joe
On Aug 3, 9:29 am, "DaveM" wrote:
Hi Joe
Error Object required
For Each lHyperlink In Sheet1.Hyperlinks
VBE shows yellow debug on line above.
Thanks for your help
Dave
"Joe HM" wrote in message
groups.com...
Set lHyperLinkList = CreateObject("Scripting.Dictionary")
Hello -
You can use the following to do that. Please note that I store
the
hyperlinks in a Scripting.Dictionary for some other reasons. You
might not have to do that. lSheetORG is the original Worksheet
and
lSheetOUT is the target Worksheet.
Set lHyperLinkList = CreateObject("Scripting.Dictionary")
For Each lHyperlink In lSheetORG.Hyperlinks
Call lHyperLinkList.Add("C" & lHyperlink.Range.Row,
lHyperlink.Address)
Next lHyperlink
lSheetOUT.Hyperlinks.Delete
lKeys = lHyperLinkList.keys
lItems = lHyperLinkList.items
For i = 0 To lHyperLinkList.Count - 1
Set lRange = lSheetOUT.Range(lKeys(i))
lSheetOUT.Hyperlinks.Add Anchor:=lRange, Address:=lItems(i),
TextToDisplay:=lRange.Value
Next i
Hope this works for you ...
Joe
On Aug 3, 8:28 am, "DaveM" wrote:
Hi all
Been trying to do this for over an hour now, with no joy.
sheet1 A1 to A36, The text values that have hyperlinks to files
on
harddrive
sheet2 Column A has lots of the same text values as sheet1, some
cells
have
a little extra text at the end.
how can I get the hyperlinks from sheet1 to all cells that
contain
the
same
text, to sheet2
Thanks in advance
Dave- Hide quoted text -
- Show quoted text -- Hide quoted text -
- Show quoted text -- Hide quoted text -
- Show quoted text -
|