Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 oups.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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 oups.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 - |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 ups.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 oups.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 - |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 ups.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 - |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 ups.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 - |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
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 - |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 - |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Hyperlinks to other cells
Hello -
Sorry for the late response but I was gone for a few days. In order to look at lHyperlink.Range.Row, you just right-click and select Add Watch... or drag and drop the selection into the Watches pane. Joe On Aug 3, 12:51 pm, "DaveM" wrote: 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 groups.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 -- Hide quoted text - - Show quoted text - |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy and paste the hyperlinks | Excel Discussion (Misc queries) | |||
Hyperlinks: Hyperlinks change on copy/paste? | Excel Worksheet Functions | |||
Copy HYPERLINKS | New Users to Excel | |||
Copy/Paste using hyperlinks | Excel Programming | |||
how do you copy hyperlinks from one worksheet to another | Excel Worksheet Functions |