Hi, i have found this code that will search a Dir then add hyperlinks, i need to do this with my sheet however, how do i modify this so as that the code will search cell ranges?
what i need it to do is search through E55 to E60 then J55 to J60 and apply a hyperlink to any cell with text in it.
the text in cell will be the name of a file in my root directory eg DYAIES-001, this text will always change as this is a template that many people will use.
directory patch e:\IsolationDataBase\IsolatorImages
i need to add the hyperlinks to the same cells mentioned above, not in another row like this one does
thanks for any help
Sub FIND_DRAWING()
Dim FindText As String
Dim MyFolder As String
Dim MyFileCount As Integer
Dim MyFileName As String
Dim MyFileType As String
Dim f
Dim WS As Worksheet
'-------------------------------------...
'- SET VARIABLES
Set WS = ActiveSheet
MyFolder = "F:\"
Set stRange = WS.Range("D2")
Do While stRange.Offset(aa, 0).Value <> ""
FindText = stRange.Offset(aa, 0).Value
MyFileType = "*" & FindText & "*.*" ' = "*Test*.*"
'-------------------------------------...
'- CHECK FILE NAMES
With Application.FileSearch
.NewSearch
.LookIn = MyFolder
.Filename = MyFileType
.SearchSubFolders = True ' True to search subfolders
'-------------------------------------...
'- RESULTS
MyFileCount = 0
If .Execute() > 0 Then
MyFileCount = .FoundFiles.Count
For f = 1 To MyFileCount
FoundRow = FoundRow + 1
MyFileName = .FoundFiles(f)
WS.Range("E" & CStr(FoundRow)).Value = WS.Range("E" & CStr(FoundRow)).Value & " " & MyFileName
WS.Hyperlinks.Add Anchor:=WS.Range("E" & CStr(FoundRow)), Address:=MyFileName, TextToDisplay:=MyFileName
Next
Else
MsgBox ("Search for file names containing : " & FindText & vbCr _
& "No matches found")
Exit Sub
End If
End With
aa = aa + 1
totalFileCount = totalFileCount + MyFileCount
Loop
'-------------------------------------...
'- finish
MsgBox ("Found " & totalFileCount & " file names.")
End Sub
Bookmarks