Problem with hyperlink macro. Works but has a defect.

Hello,
I have the following macro which works fine except when it cannot find a
file that match the search string.

When it does not find what it is looking for it goes to cell A1 in the
starting workbook where the macro button is and dumps the list of file
names it found in the directory searched... and overwrites whatever is
there. The user starts by selecting a cell in column G and press the
Hyperlink With Job Search button. It asks for a string to search and
creates a link to the appropriate file in the folder.

I would like the macro to say it did not find the file and to try again.

I'd appreciate any help with this.

Denis
-----------------------------------------------------------------------


Sub FastHyperlink()
Call List_DirectoryFast

End Sub

Sub List_DirectoryFast()

Dim stMyPATH As String
Dim stFILE As String
Dim I As Long
Dim MyRANGE As Range
Dim F As Variant
Dim C As Object


Application.ScreenUpdating = False

On Error GoTo OpenWorkBook:
Dim BookName As String
BookName = "FileList.xlsx"
Workbooks(BookName).Activate



OpenWorkBook:
If Err.Number = 9 Then
Workbooks.Open FileName:="\\Fsnt07\poly_od\UnApproved\_Quality\Raw Materials\MasterBatch\Accepted C of A's\FileList.xlsx"
Resume
End If


ActiveWindow.SmallScroll Down:=-21
Range("A1").Select

Cells(1, "A").EntireColumn.Clear
stMyPATH = "\\Fsnt07\poly_od\UnApproved\_Quality\Raw Materials\MasterBatch\Accepted C of A's"
'---- LOOK FOR FILES and DIRECTORIES ----
stFILE = Dir(stMyPATH & "\*.*", vbDirectory)
I = 1
Do Until stFILE = ""
If ((stFILE <> ".") And (stFILE <> "..")) Then
Cells(I, "A") = stFILE
I = I + 1
End If
stFILE = Dir()
Loop


Range("A:A").ColumnWidth = 30


Application.Workbooks("FileList.xlsx").Activate

'find wildcard character * in text
Dim cell As Range, FirstAddress As String, FoundList As String
With ActiveSheet.UsedRange
Dim sFind As String

sFind = Application.InputBox("Enter the search string")
'use tilde to find an *
Set cell = .Find(sFind, LookIn:=xlValues, SearchOrder:=xlByRows,
_
LookAt:=xlPart)
If Not cell Is Nothing Then
FirstAddress = cell.Address '< Bookmark start point
Do
FoundList = FoundList & "Cell " & cell.Address(0, 0) & _
" =" & vbTab & cell & vbNewLine
Set cell = .FindNext(cell)
Loop Until cell Is Nothing Or cell.Address = FirstAddress
End If
End With

Application.Workbooks("Masterbatch Log Sheet.xls").Activate

Application.ScreenUpdating = True

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=("\\Fsnt07\poly_od\UnApproved\_Quality\Raw Materials\MasterBatch\Accepted C of A's\") & cell
TextToDisplay = "C o A"

Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Set cell = Nothing

Application.Workbooks("FileList.xlsx").Activate
ActiveWorkbook.Close False

MsgBox "Hyperlink has been created"

End Sub

Something like this...

With ActiveSheet.UsedRange
    Dim sFind As String
    sFind = Application.InputBox("Enter the search string")
    'use tilde to find an *
    Set cell = .Find(sFind, LookIn:=xlValues, SearchOrder:=xlByRows, LookAt:=xlPart)
    If Not cell Is Nothing Then
        FirstAddress = cell.Address    '< Bookmark start point
        Do
            FoundList = FoundList & "Cell " & cell.Address(0, 0) & _
                        " =" & vbTab & cell & vbNewLine
            Set cell = .FindNext(cell)
        Loop Until cell Is Nothing Or cell.Address = FirstAddress
    Else
        MsgBox "No match found"
        Exit Sub
    End If
End With

That worked - along with another change I made to close the FileList.xlsx sheet.

You're welcome.