help:-) Need a complicated hyperlink macro if poss

[John Caines]

Hello all.
I put a post up recently asking if possible for a macro to convert a large column of rows of data(About 30,000) to hyperlinks as they were webpage domains written a certain way.
They were written like this,

reigninggifts.com (http://reigninggifts.com)

and needed to be converted to this,
http://reigninggifts.com
which would be an active hyperlink.

VOGII got back to me with a great macro that solved the solution which was

Sub HyperlinkConverter()
Dim lastrow As Long, i As Long
Dim j As Integer, k As Integer, web As String
Dim t As Date
t = Now()
Application.ScreenUpdating = False
Application.Calculation = xlManual
lastrow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 4 To lastrow
    j = InStr(Cells(i, 3).Value, "(")
    k = InStr(Cells(i, 3).Value, ")")
    web = Mid(Cells(i, 3).Value, j + 1, k - j - 1)
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=web, TextToDisplay:=web
Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
MsgBox "Hyperlink Converting Run Time: " & Format(Now() - t, "hh:mm:ss")
End Sub

Well, things seem to have gotten a bit more complicated now unfortunately.
I have had to combine several sheets into 1 (Which isn't a problem) but the column of web page domains are all written differently and all need to be active and formatted to look the same.
I shall give an example of what I have, and if possible, if a macro could be written to convert them all to open their domain web page in a uniform format.
(By the way, there are other columns of data in the spreadsheet, but these aren't an issue I think)

Here is a small list of what I have;

4cm.com
4crossfire.com
4her4him.net
abbeytrade.com
abcnews.go.com
abekaacademy.org
http://airlines-flight.net
http://airlines-hq.com
http://airline-sports-concert-show-tickets.com
http://airman.com
http://airner.info
http://airplanetickets.fjore.info
http://airplanetickets.fjore.info
soundclick.com
soundexpressiongreetings.com
soundgrid.net
southafrica.info
http://www-suif.stanford.edu
http://www-sul.stanford.edu
http://www-sul.stanford.edu
http://www-truck-deals.info
http://www-truck-news.info

All of these now are not hyperlinked to open a webpage (And so are not a blue colour).

Is it possible to write a macro that goes through the list (Which can vary in length) which at present is now in Col B, starting from row 4, and in this case going down to row 37,284.
Can the macro convert them to hyperlinks which all read in the same format (So I can delete duplicates.
because at the moment I might have a domain in colB which is;
http://yambot.com and another called
http://www.yambot.com,,, and so excel is not recognising the duplicates.
(And they all need to be active anyway

If possible I would like them to all start with;
http://

So from my example above, the macro would run and convert all the urls to be active hyperlinks that would end up looking like the following;

http://4cm.com
http://4crossfire.com
http://4her4him.net
http://abbeytrade.com
http://abcnews.go.com
http://abekaacademy.org
http://airlines-flight.net
http://airlines-hq.com
http://airline-sports-concert-show-tickets.com
http://airman.com
http://airner.info
http://airplanetickets.fjore.info
http://airplanetickets.fjore.info
http://soundclick.com
http://soundexpressiongreetings.com
http://soundgrid.net
http://southafrica.info
http://www-suif.stanford.edu
http://www-sul.stanford.edu
http://www-sul.stanford.edu
http://www-truck-deals.info
http://www-truck-news.info

Then I can remove duplicates after.
I hope this all makes sense.
If anyone needs the xls sheet to see exactly what it looks like please pm me or just email me at john777(@)truemail.co.th
and I'll attach it to a mail.
Zipped up it's approx 1.2mb

I hope someone can help me out here.
All beyond me I'm affraid.
I hope it all makes sense
Many Thanks
John Caines

 

[VoG]

Hi John

Try this

Sub HyperlinkConverter2()
Dim lastrow As Long, i As Long
Dim web As String
Dim t As Date
t = Now()
Application.ScreenUpdating = False
Application.Calculation = xlManual
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 4 To lastrow
    web = Cells(i, 2).Value
    If Left(web, 7) <> "http://" Then web = "http://" & web
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), Address:=web, TextToDisplay:=web
Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
MsgBox "Hyperlink Converting Run Time: " & Format(Now() - t, "hh:mm:ss")
End Sub

 

[John Caines]

many thanks VOGII

Hello VOGII
Many thanks for your reply.
Couldn't get the macro to work though

I do feel I owe you a slight Apologyfor this though.
In hindsight some of this data I should have been able to manipulate myself.

I am a real novice with combining data etc.
Just read the help in excel for joining names!

Haven't used these functions for ages, I should know them.
I've sent you an email explaining all.

Sorry, but I couldn't get the macro to work.
Have sent you the sheet .
Many thanks for all your help VOGII.
Hopefully, my email explains all
I don't want to take your time up on this 1
Sorry for any Inconvenience

Many thanks
John Caines