Extract URL from Link Cell / Convert imported text links to hyperl

[Brent E]

Good day,

This is a continuation to a post from yesterday.

My original question had two parts. Part 2 has been resolved and am pasting
the resolution in case that will be useful to somebody in the community.

I still need assistance resolving Part 1.

================
Part 1 addressed how to extract the hyperlink URL from label cells in Col B
and paste the address values in adjacent cells in Col C.

Sample Data:
B C
Google Blank
Yahoo Blank

Resulting Data Should be
B C
Google http://www.google.com
Yahoo http://www.yahoo.com

With the assistance of Sheeloo, I was able to test the following code.
Dim i
Dim LastRow
LastRow = Range("B431").End(xlUp).Row
For i = 414 To LastRow
Cells(i, 3).Value = Cells(i, 2).Hyperlinks(1).Name
Next i

This code works for the first row of data and extracts the address from the
first cell, but then does not populate the adjacent cells for the rest of the
cells in the range.

Any suggestions as to why this is occurring?


Thanks,


================
Part 2. This issue addressed hyperlinks being pasted in a cell or imported
from a database and appearing as text in a cell rather than as a hyperlink.
The only apparent way to make the cells into hyperlinks was to double click
on each cell and then press ENTER. This would then create a hyperlink from
the text.

In hopes, of benefiting fellow users in the community, the following code
works well for this.

From a list of hyperlinks in text form, this code dynamically selects cells
in Col B from Row 2 to end of the col. The code then makes hyperlinks out of
the text in the cells.

Sub Links()

'Select Cells in Col B from B2 to End of Populated Data
Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Select

'Create links from the text in the cells
For Each xCell In Selection
ActiveSheet.hyperlinks.Add Anchor:=xCell, Address:=xCell.Formula
Next xCell

End Sub

 

[Mike H]

hi,

Maybe this

Sub marine()
Dim myrange As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = Range("B1:B" & LastRow)
For Each c In myrange
Hyperlinks.Add c.Offset(, 1), "http://www." & c.Value & ".com/"
Next
End Sub

Mike

 

[Sheeloo]

Hello,

Can you tell me what is in B415? I again tested the code and it works fine
for me...

It does fail if I have HYPERLINK formula in a cell...

Add the following line after the "For i = 414 To LastRow" line in your code
given below;
On Error Resume Next

This will help you find out the cells it is failing on and possibly the
reason.

Thanks for sharing your feedback in such a nice way...

 

[Brent E]

Mike,

Thanks for your assistance and the code suggestion. The cells are already
links w/ the URL, but only the cells contain labels to the links. For example
if the label cell says "Google Website", but if u click on it, takes u to
www.google.com.

I am trying to mine the full URL out of the Label in Col B, then paste the
full URL in Col C. So would extract the URL from the "Google Website" cell
and place www.google.com in Col C.

Thanks,

============
Sheeloo,

Thanks for your assistance as well. Yes, you were right, the next cell down
I found was not linked as I thought, only had the formatting of a link so I
dind't catch that, the code works fine now, except it mines out the label
data rather than the URL.

For example in the sample I mentioned above to Mike, if "Google Website"
were in Col B, but embedded in the cell is the link to google. If I run the
code, I am getting "Google Website" placed in Col C rather than the URL.

Any suggestions?

Thanks.