How can I speed this up?

[mbrwny20]

Hello, I have a closed workbook that I am treating as a database. I run sql queries for searches and return results to my searching workbook. I used the code found here: http://www.erlandsendata.no/english/...nvbadacwbdbado

It works great! and is very fast. However the next step is to look at the results, then based on criteria, look in a folder to see if a file exists. If it does, then create a hyperlink to that file. This part works as well, but is quite slow. Is there a way for me to speed this part up. Any help would be greatly appreciated. My hyperlink code is below.

P.S. I search for files with any extension ".*", then I pull the extension in my function (MyExt),to place in the hyperlink. This allows me to link to .doc,.xls,.pdf etc. Being new at VBA in general, I thought that was a pretty good solution. But if it is slowing me down I'll change it.

[vba]Public MyExt As String

Sub Links()
Dim i As Integer
Dim MyFile As String
Dim MyFolder As String
Dim MyLink As String
Dim MyDir As String

MyDir = ("\\server\shr\")

For i = 8 To 10000

If Cells(i, 1) <> "" Then
MyFile = Cells(i, 1).Value
MyFolder = "procedures\"
Else: Exit Sub
End If

If FileThere(MyDir & MyFolder & MyFile & ".*") Then
MyLink = MyDir & MyFolder & MyFile & MyExt
Cells(i, 1).Hyperlinks.Add Anchor:=Cells(i, 1), _
Address:=MyLink, TextToDisplay:=MyFile
Application.EnableEvents = True
End If

If Cells(i, 5) <> "" Then
MyFile = Cells(i, 5).Value
MyFolder = "worksheets\"

If FileThere(MyDir & MyFolder & "\" & MyFile & ".*") Then
MyLink = MyDir & MyFolder & MyFile & MyExt
Cells(i, 5).Hyperlinks.Add Anchor:=Cells(i, 5), _
Address:=MyLink, TextToDisplay:=MyFile
Application.EnableEvents = True
End If

End If

Next i

End Sub


Public Function FileThere(FileName As String) As Boolean
FileThere = (Dir(FileName) > "")
MyExt = Right((Dir(FileName)), 4)
End Function[/vba]

[Ken Puls]

Hi there,

Your speed will be due to using a loop (For each) to check your data. Some tricks to consider:
-Apply an autofilter to the column so that only valid data is presented, then loop through the visible rows (use the specialcells method). This will allow you to avoid checking rows for this kind of thing: If Cells(i, 1) <> "" Then

-Make your loop a little more dynamic. Instead of hard coding 10000 rows, many of which may be empty and just consume time, try to make your loop go from the first row of data to the last row. Something like:
[vba]For i = 8 to Activesheet.Range("A" & Activesheet.Rows.Count).End(xlup).Row[/vba]

Let us know if you need any help applying it.

[johnske]

Using an index variable (i) will also slow it down, try using something like this (untested)[vba]Option Explicit

Public MyExt As String

Sub Links()
Dim Target As Range
Dim MyFile As String
Dim MyFolder As String
Dim MyLink As String
Dim MyDir As String

MyDir = ("\\server\shr\")

For Each Target In Range("A1", Range("A" & Rows.Count).End(xlUp))

If Target = Empty Then
Exit Sub
Else
MyFile = Target
MyFolder = "procedures\"
End If

If FileThere(MyDir & MyFolder & MyFile & ".*") Then
MyLink = MyDir & MyFolder & MyFile & MyExt
Target.Hyperlinks.Add Anchor:=Target, _
Address:=MyLink, TextToDisplay:=MyFile
Application.EnableEvents = True
End If

If Target.Offset(0, 4) <> "" Then
MyFile = Target.Offset(0, 4)
MyFolder = "worksheets\"

If FileThere(MyDir & MyFolder & "\" & MyFile & ".*") Then
MyLink = MyDir & MyFolder & MyFile & MyExt
Target.Offset(0, 4).Hyperlinks.Add Anchor:=Target.Offset(0, 4), _
Address:=MyLink, TextToDisplay:=MyFile
Application.EnableEvents = True
End If

End If

Next

End Sub


Public Function FileThere(FileName As String) As Boolean
FileThere = (Dir(FileName) > "")
MyExt = Right((Dir(FileName)), 4)
End Function[/vba]

EDIT: Also, try using Application.ScreenUpdating = False near the top of your code and Application.ScreenUpdating = True as the penultimate line.

[mbrwny20]

Thank you both for your help. It runs about 25% faster now. Excellent.