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.