Hyperlink to outside folder

[jacobs.590]

Hello,

I need a little help refining a macro that we are using. We are using this macro to link values in a worksheet to documents with the matching name in an outside folder. This portion is working ok. The problem I'm having comes when theres a blank cell in the worksheet. Then the macro will randomly put some hyper link in the blank cell. How to I tell it to ignore the blank cells?

Sub HQ_LINK_MAKER()
Dim MyFolder As String
MyFolder = "\\svna001.tstna.com\users\Engineering_Administration\GENERAL\Special Projects\TC Circle\Trial\TST PO"
Dim LASTROW As Long
Dim FIRSTROW As Long
Dim I As Long
Dim f  As Integer
Dim MyFileCount As Integer
Dim WS As Worksheet
    Set WS = ActiveSheet
    FIRSTROW = 5
    LASTROW = Range("G" & Rows.Count).End(xlUp).Row
    For I = FIRSTROW To LASTROW
        FindText = Range("G" & I).Value
        MyFileType = "*" & FindText & "*.*"             ' = "*Test*.*"
'- CHECK FILE NAMES
        With Application.FileSearch
            .NewSearch
            .LookIn = MyFolder
            .Filename = MyFileType
'- RESULTS
            MyFileCount = 0
            If .Execute() > 0 Then
                MyFileCount = .FoundFiles.Count
                For f = 1 To MyFileCount
                    MyFileName = .FoundFiles(f)
                    WS.Hyperlinks.Add Anchor:=Range("G" & I), Address:=MyFileName, TextToDisplay:= _
                    Replace(.FoundFiles(f), MyFolder & "\", "")
                Next
                Else
                    MsgBox ("Search for file names containing : " & FindText & vbCr _
                    & "No matches found")
            End If
        End With
    Next I
End Sub

[Leith Ross]

Hello jacobs.590,

Welcome to the Forum!

Here is the amended version of your macro. An IF THEN statement has been added that checks for blank cells.

Sub HQ_LINK_MAKER()

  Dim MyFolder As String
  Dim LASTROW As Long
  Dim FIRSTROW As Long
  Dim I As Long
  Dim f  As Integer
  Dim MyFileCount As Integer
  Dim WS As Worksheet
  
    MyFolder = "\\svna001.tstna.com\users\Engineering_Administration\GENERAL\Special Projects\TC Circle\Trial\TST PO"
    
    Set WS = ActiveSheet
    FIRSTROW = 5
    LASTROW = Range("G" & Rows.Count).End(xlUp).Row
    
    For I = FIRSTROW To LASTROW
        FindText = Range("G" & I).Value
        
      '- IGNORE BLANK CELLS
        If FindText <> "" Then
        
           MyFileType = "*" & FindText & "*.*"      ' = "*Test*.*"
           
          '- CHECK FILE NAMES
             With Application.FileSearch
              .NewSearch
              .LookIn = MyFolder
              .Filename = MyFileType
            '- RESULTS
              MyFileCount = 0
                If .Execute() > 0 Then
                   MyFileCount = .FoundFiles.Count
                   For f = 1 To MyFileCount
                     MyFileName = .FoundFiles(f)
                     WS.Hyperlinks.Add Anchor:=Range("G" & I), Address:=MyFileName, TextToDisplay:= _
                     Replace(.FoundFiles(f), MyFolder & "\", "")
                   Next
                Else
                     MsgBox ("Search for file names containing : " & FindText & vbCr _
                     & "No matches found")
                End If
             End With
             
        End If
        
    Next I
    
End Sub

[jacobs.590]

Leith Ross -

Your suggestion worked perfectly. Thank you very much. Your help was usefull indeed.