Interesting hyperlink macro problem

[DobberHockey]

I run a website and this website has 1000+ hockey player profile pages. Each article that I write, or is written for me, it would be fantastic if I could click a "run macro" button and have every instance in which a player's name is mentioned, a hyperlink to his profile page gets inserted.



I can get a list of player names and hyperlinks on an Excel template.

Any advice on how I can set this up?

Thanks

[macropod]

Hi DobberHockey,

You don't need a macro for this. Simply create a single hyperlink for a given player in the document, with the payer's name for the display text, cut/copy that hyperlink to the clipboard then use Find/Replace, where:
Find = Player's name
Replace = ^c

If you create a Word document with all of these hyperlinks in place, it then becomes a simple matter of opening that document, copying a given hyperlink, then using the above Find/Replace in the article document.

[DobberHockey]

Hi Macropod,

That doesn't sound like the solution I need because we are talking about three to four columns/articles per day and upwards of 10 to 50 different player names in each article (and each player's full name is only mentioned once per article - so a find/replace is unnecessary). By the time I'm done looking up each player on the spreadsheet (say 1000 names/links), copying the hyperlink, and adding them one by one...would take a long time.

I'd like a macro that would scan the article, pick out the player names that match what is on the Excel list, and insert the hyperlink. All players mentioned get linked with one click.

[macropod]

Hi DobberHockey,

The coding for what you describe isn't exactly trivial. Try the following Word macro and see how it goes. I can't test it as I don't have anything like your document & Excel workbook setup to do so with. You'll have to make a number of changes to the macro's Excel workbook references. You'll need to change:
StrWkBkNm = "C:\Users\Username\Documents\Workbook Name.xls"
to point to your workbook;
With xlWkBk.Worksheets("Players")
to point to the correct worksheet; and the
'A' and 'B' references in the two occurrences of .Range("A" & i) and .Range("B" & i)
to point to the columns containing the player names and their web pages, respectively.

If you add the code to Word's Normal template, or to the template for your columns/articles it should be available for all of your columns/articles.

Option Explicit
 
Sub BulkHyperlinkInsertion()
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String
Dim iDataRow As Long,  xlFList As String, xlHList As String, i As Long
StrWkBkNm = "C:\Users\Username\Documents\Workbook Name.xls"
Const StrWkSht As String = "Players"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  ' The file is available, so open it.
  Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit
    Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk
    'Ensure the worksheet exists
    If SheetExists(xlWkBk, StrWkSht) = True Then
      With .Worksheets(StrWkSht)
        ' Find the last-used row in column A.
        iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
        ' Capture the F/R data.
        For i = 1 To iDataRow
          ' Skip over empty fields to preserve the underlying cell contents.
          If Trim(.Range("A" & i)) <> vbNullString Then
            xlFList = xlFList & "|" & Trim(.Range("A" & i))
            xlRList = xlHList & "|" & Trim(.Range("B" & i))
          End If
        Next
      End With
    Else
      MsgBox "Cannot find the designated worksheet: " & StrWkSht, vbExclamation
    End If
  .Close False
  End With
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub 
'Process each word from the Player List
For i = 1 To UBound(Split(xlFList, "|"))
  With ActiveDocument.Range
    With .Find
      .Text = Split(xlFList, "|")(i)
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .MatchCase = True
      .Execute
    End With
    'Change the found text to a hyperlink
    Do While .Find.Found
      .Duplicate.Hyperlinks.Add Anchor:=.Duplicate, Address:=Split(xlHList, "|")(i)
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
Application.ScreenUpdating = True
End Sub
 
Function SheetExists(xlWkBk As Object, SheetName As String) As Boolean
Dim i As Long: SheetExists = False
With xlWkBk
  For i = 1 To .Sheets.Count
    If .Sheets(i).Name = SheetName Then
      SheetExists = True:   Exit For
    End If
  Next
End With
End Function

[DobberHockey]

Wow - thanks! This looks like a winner, I have to admit that I didn't think it could be done.

Thanks again, I can't express how much work this would save.

[DobberHockey]

Hi there,

(fantastic code by the way)

I finally got a full Excel template with the players in column A and their hyperlinks in column B. I ran the macro on my Word document after writing a column. There were approximately 30 player names mentioned. The macro went through and auto hyper-linked FIVE of them, leaving 25 not done.

I investigated why:
1. Upper/lower case was fine.
2. Spelling was fine
3. double checked for spacing, etc. Everything seems fine

So I went through to see what was linked vs what was not. It linked the players on lines:
59
296
317
815
852

That was it. So my first theory was that it only worked on the first 1000 lines (there are about 3000 lines in the Excel template). But I looked at some of the players not linked:
2602, 1255, 728, 381, 265, 855, 1656

There goes that theory. Then I found it.

The code was going through the Excel list line by line and checking in the Word doc for a match. When it found a match, it linked it. Then it would move onto the next player. BUT, it would pick up in the Word document where it left off. The first player found, from line 59, was on page 2. The next player found, line 296, was mostly down page 3. The next player was halfway down page 4, the next was just underneath that one. And the final player was the final player mentioned on the document, line 852.

Can the code be adjusted to start the check at the top of the document each time it loops? Thanks!

[macropod]

Try changing:

With ActiveDocument.Range
  'Process each word from the Player List
  For i = 1 To UBound(Split(xlFRList, "|"))

to:

'Process each word from the Player List
For i = 1 To UBound(Split(xlFRList, "|"))
  With ActiveDocument.Range

and:

  Next
End With

to:

  End With
Next

As you can see, this is just a simple matter of moving two lines and changing the indenting. The indenting is of no consequence though, to the code's execution.

[DobberHockey]

Worked!

Thank you again! All players found and linked