Placing a hyperlink into a variable

[RoyR]

Is it possible to place a hyperlink into a variable? For example: Cell A1 contains an internet hyperlink. I want to place that link into a variable which can later be placed back into another cell.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Something like:
Dim X As String<o></o>
X = Range("A1").Value<o></o>
Range("A10").Value = X
<o> </o>
Of course, this only places the Value of A1 into A10. Not the hyperlink itself. I think I would need to use “PasteSpecial” but have not had luck in getting this to work. I am also sure I can not use “Value” as I believe that strips off all formatting etc..
<o> </o>
Any help in this matter would be much appreciated. Thank you in advance.

 

[dave3009]

Perhaps use the hyperlink function

Sub Macro1()
Dim x As String
x = Range("A1").Value
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A10"), Address:= _
        "http://www.website.co.uk", ScreenTip:=x, TextToDisplay:=x
End Sub

 

[RoyR]

Thank you for the reply. I need to get the hyperlink out of a cell and then able to place in back into a different cell. The actual hyperlink would not be known to me at the time of writing the macro and there would be many of them. (25 to 30 thousand links) Right now, I accomplish the task by the copy, pastespecial method but it leads to hundreds of lines of code as I go back and forth between mulitiple workbooks. Then when I need to make a change, it takes a long time to sort out the code looking for what needs to be modified.

So I thought if I could simply place the hyperlink into variable, it would vastly clean up the code and make it easy to modify as needed.

I use Excel 2003 on a Windows 7 machine.

This is how I do it now...

Windows(WB).Activate
Range("M4:O4").Select
Selection.Copy
Windows("Mov.xls").Activate
Range("I" & R).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(WB).Activate
Range("K8").Select
Selection.Copy
Windows("Mov.xls").Activate
Range("L" & R).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(WB).Activate
Range("K9").Select
Selection.Copy
Windows("Mov.xls").Activate
Range("M" & R).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

This code repeats over and over as the data in one workbook is in a columb while in the next one, it is stored in a row. I hope I am clear in what I am trying to do. Thank you for any help you have to offer.

 

[RoyR]

Oops... the code I added is where the Hyperlink is removed... where it is not removed, the code looks like this

Windows(WB).Activate
Range("K13").Select
Selection.Copy
Windows("Mov.xls").Activate
Range("S" & R).Select
ActiveSheet.Paste

And as I said earlier, this repeats over and over as I copy hyperlinks from one workbook to another

 

[dave3009]

I see, you could loop through your range and if a hyperlink exists in the cell then copy it over. Here is an example of the basic premise

Sub hyps()
Dim lst As Long
Dim dest As Long
Dim c As Range
Dim my As Range
lst = Range("A" & Rows.Count).End(xlUp).Row
dest = 1
Set my = Range("A1:A" & lst)
For Each c In my
    If c.Hyperlinks.Count > 0 Then
       c.Copy Range("B" & dest)
       dest = dest + 1
    End If
Next c

End Sub

 

[RoyR]

I will play with the code you provided and see how it works for me. My macro does work but it is just long and sloppy. I wanted to clean it up and of course, the best way to learn to code is to write it. When ever I have the time, I like to take my old code and try to make it cleaner and better.

Thank you for your help

 

[dave3009]

Commented code to help you out

Sub hyps()
' Find last row on current sheet
Dim lst As Long

' find last row on destination sheet
Dim dest As Long

' create a variable for the cell
Dim c As Range

' create a range within which to loop
Dim my As Range

' find the last row on the origina sheet
' you may also consider setting a last column
' or just hard code the range
lst = Range("A" & Rows.Count).End(xlUp).Row
dest = 1

' Set the origin range
Set my = Range("A1:A" & lst)

'loop through each cell in the the origin range
For Each c In my
    
    'if a hyperlink exists the count will be greater than one
    If c.Hyperlinks.Count > 0 Then
    
        ' find the last row in the destination
        dest = Range("B" & Rows.Count).End(xlUp).Row + 1
        
        ' so copy that range to destination
        c.Copy Range("B" & dest) ' - for another workbook use Workbooks("workbook.xls").Sheets("sheetname").Range(....
        
    End If

' repeat the process until all cells have been visited
Next c

End Sub