Can anyone help. I have the following code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 7 Then
MakeHyperLink Target, "Q:\"

End If

End Sub

Option Explicit
Private Files As Dictionary
Private StrFile As String
Dim StrFlePath As String, FleCollection, fle, f1, fs, f2, subfld
Sub MakeHyperLink(InRange As Range, _
ToFolder As String, _
Optional InSheet As Worksheet, _
Optional WithExt As String = "doc")
Dim rng As Range
Dim Filename As String
Dim Ext As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

If Files Is Nothing Then
GetFileAddress
End If

'check to see if folder has trailing \
If Right(ToFolder, 1) <> "\" Then
Filename = ToFolder & "\"
Else
Filename = ToFolder
End If
'check to see if need ext
If WithExt <> "" Then
'check to see if ext has leading dot
If Left(WithExt, 1) <> "." Then
WithExt = "." & WithExt
End If

End If
'if not explicit sheet then assign active
If InSheet Is Nothing Then
Set InSheet = ActiveSheet
End If
'now for every cell in range
For Each rng In InRange
'does range have value
If rng <> "" Then
'make hyperlink to file
StrFlePath = Files(UCase(rng.Text & WithExt))

InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
StrFlePath, TextToDisplay:=rng.Text

End If

Next

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With

End Sub
Sub GetFileAddress()
Set Files = New Dictionary
FindFolder "Q:\"
End Sub
Sub FindFolder(strPath As String)
Set fs = CreateObject("scripting.filesystemobject")
Set f1 = fs.GetFolder(strPath)
Set f2 = f1.SubFolders
Set FleCollection = f1.Files
For Each fle In FleCollection

If Not (Files.Exists(UCase(fle.Name))) Then

Files.Add UCase(fle.Name), fle.Path

End If
Next
For Each subfld In f2
FindFolder subfld.Path
Next

End Sub

This works perfectly except for one thing, when you first open the workbook and type the file name in the G column (7), it takes about 15 minutes for the code to run and find the file name. After that you can type the file name and it only takes a second. Once you close the workbook and open it back up then you have to wait at least another 15 minutes after you type the first filename again. Is there a way for it not to take so long to when in type the filename in the first time.

Also I want to know how do I write this line for any type of document that maybe in the folder? Not just doc file, but txt, xml or any type of file that is in the folder.

Optional WithExt As String = "doc")
This article has been dead for over six months. Start a new discussion instead.