Sort Tags into Column A and hyperlinks into Column B, Repeat Tags when needed

[Pavel001]

Hello,
I have 600 lines of data in this format. Its a tag name, skip a line, hyperlinks associated with that tag name, skip a line and then the next tag name. This is what it looks like:


Application

EIN Individual Request - Online Application

Art

Banksy - Outdoors

Bible

The complete Blogging the Bible, so far. - By David Plotz - Slate Magazine


Freelance

Guru.com – Find freelancers at the world’s largest online service marketplace.
Elance - Outsourcing to freelance programmers, web & logo designers, copywriters, illustrators and consultants | Elance

Funny

thisisby.us - Women's Secrets, by citywendy
Daily Comedy | Always Fresh. Always Funny. Jokes, Videos and more, daily!


I need it to look like this in two columns.
Application:EIN Individual Request - Online Application
Art:Banksy - Outdoors
Bible:The complete Blogging the Bible, so far. - By David Plotz - Slate magazine
Freelance:Guru.com – Find freelancers at the world’s largest online service marketplace.
Freelance:Elance - Outsourcing to freelance programmers, web & logo designers, copywriters, illustrators and consultants | Elance
Funny:thisisby.us - Women's Secrets, by citywendy
Funny:Daily Comedy | Always Fresh. Always Funny. Jokes, Videos and more, daily!

I have no idea how to do this and would deeply appreciate any assistance.

All the best,
Pavel

[mojo249]

Try this. It combines values in column A into column B.

Sub Bookmarks()

Dim varLastRow As Long
Dim varRow As Long
Dim varName As String
Dim varLink As String

On Error Resume Next

varLastRow = Sheets("Sheet1").Range("A65000").End(xlUp).Row

For varRow = 3 To varLastRow
    If Cells(varRow, 1).Value <> "" Then
        If Cells(varRow, 1).Hyperlinks.Count = 0 Then
            varName = Cells(varRow, 1).Value
        Else
            varLink = Cells(varRow, 1).Value
            Range("B65000").End(xlUp).Offset(1).Value = varName & ": " & varLink
            Range("B65000").End(xlUp).Hyperlinks.Add Range("B65000").End(xlUp), GetAddress(Cells(varRow, 1)), , , Range("B65000").End(xlUp).Value
        End If
    End If
Next varRow

End Sub

Function GetAddress(HyperlinkCell As Range)

    GetAddress = Replace(HyperlinkCell.Hyperlinks(1).Address, "mailto:", "")

End Function

[Pavel001]

Worked perfect! Thank you for your help.

Pavel