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?
