Macro to Export Hyperlinks from Excel to Word

In this tutorial I am going to show you how to write a VBA macro to export hyperlinks from Excel to Word. I’m all about automation and efficiency and this is another real world example. I used this macro to quickly create a table of the world’s observation wheels for my latest website.

What you will learn by reading through this tutorial:

• How to create a VBA macro to send data from Excel to Word
• How to export hyperlinks from Excel
• How to find the last row of data in an Excel sheet using a macro
• How to paste hyperlink into Word using a macro
• How to make a webpage from an Excel file

To begin, we have an Excel sheet with names in column A, some of them are hyperlinks to webpages and some of them are not. Hit Alt + F8 and create a new macro, I named mined Tables. It’s time to begin coding.

 

 

The first thing we need to do is create a new instance of Microsoft Word and make it visible:

 

Dim appWD As Word.Application

Set appWD = CreateObject("Word.Application")

appWD.Visible = True

 

Next, let’s find the last row that contains data within our active Excel spreadsheet (my sheet is called “Data”):

 

Sheets("Data").Select

            Dim FinalRow As Integer

 

            FinalRow = Range("A9999").End(xlUp).Row

 

Now we add some error handling - if there is no data then quit the program, otherwise continue on:

If FinalRow = 0 Then

            Exit Sub

 

            Else

 

As a check, I like to have a message box pop-up displaying the total number of rows with data:

 

            MsgBox "Number of rows is " & FinalRow

 

Now it’s time to tell Word to create a new document. We’ll also add our header text by using TypeText. TypeParagraph inserts a new paragraph by going to the next line:

 

            appWD.Documents.Add

            appWD.Selection.TypeParagraph

 

            appWD.Selection.TypeText Text:="[table caption= List of Observation Wheels]"

 

            appWD.Selection.TypeParagraph

 

            appWD.Selection.TypeText Text:="Name,Height(m)"

Next, we’ll create a For...Next loop to cycle through every row and look to see if there is a hyperlink in column A. If there is a hyperlink, we want to copy it, if not then we still want to copy any text in the cell.

 

Dim hyperlink1 As String

Dim i As Integer

 

            For i = 2 To FinalRow

 

            If Range("A" & i).Hyperlinks.Count > 0 Then

 

 

            'if there is a hyperlink

 

            appWD.Selection.TypeParagraph

 

            hyperlink1 = Range("A" & i).Hyperlinks(1).Address

 

            appWD.ActiveDocument.Hyperlinks.Add Anchor:=appWD.Selection.Range,          Address:=hyperlink1, SubAddress:="", ScreenTip:="", TextToDisplay:=Range("A" & i)

 

            appWD.Selection.TypeText Text:="," & Range("B" & i)

 

 

            Else

 

 

            'If no hyperlink

 

            appWD.Selection.TypeParagraph

 

            appWD.Selection.TypeText Text:=Range("A" & i) & "," & Range("B" & i)

 

 

            End If

 

            Next 'i

 

Finally, we can add any text at the bottom of the document and close the if and sub statements.

 

            'end the table

            appWD.Selection.TypeParagraph

            appWD.Selection.TypeText Text:="[/table]"

            End If

            End Sub

 

You may have noticed I began and ended with [table] and [/table]. I installed a Wordpress plugin on my website that enables me to easily insert sortable tables into my webpage without any major html coding involved. So now I can run my macro on my spreadsheet, copy the result it spits out into Word, and paste the text into my website. Here is the end result, a sortable table of all large observation wheels found throughout the world! Pretty cool huh?