Advice to speed up process

D

dd

I have a file index, which inputs the paths in various columns for
Autofiltering and makes the files into hyperlinks. It takes a while to
process (22 rows takes approx 2 mins to process). There will be more files
added as work proceeds. I want to know if there is a way to speed up the
process, I've tried Application.Screenupdating = True/False, but it seems to
take longer using this.
==
If oFolder.Files.Count > 0 Then
For Each oFile In oFolder.Files
If oFile.Type = filetype Then

sFile = Mid(oFile.Path, 1)

'Start of first value iPos1 =
InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\")
'End of first value and start of second value
iPos2 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\")
'End of second value and start of third value
iPos3 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\") + 1, sFile, "\")
'End of third value
iPos4 = InStrRev(sFile, "\")

'first string
Cells(iFile, iPathColA).Value = Mid(sFile, iPos1 + 1, iPos2 - iPos1)

Cells(iFile, iPathColB).Value = Mid(sFile, iPos2 + 1, iPos3 - iPos2)

Cells(iFile, iPathColC).Value = Mid(sFile, iPos3 + 1, iPos4 - iPos3)

Cells(iFile, iFileCol) = oFile.Name

' And a link in the Hyperlink column
Cells(iFile, iLinkCol).FormulaR1C1 = "=HYPERLINK(root &
RC[-4] & RC[-3]& RC[-2] & RC[-1] ,""HERE"")"

iFile = iFile + 1
End If
Next oFile
End If
 
G

Guest

application.Calculation = xlManual
' current code
Application.Calculation = xlAutomatic
 
J

Jim Cone

Possibly the free Excel add-in List Files will do what you want.
Download from... http://www.realezsites.com/bus/primitivesoftware
No registration required.
--
Jim Cone
San Francisco, USA


"dd" <dd.dd> wrote in message
I have a file index, which inputs the paths in various columns for
Autofiltering and makes the files into hyperlinks. It takes a while to
process (22 rows takes approx 2 mins to process). There will be more files
added as work proceeds. I want to know if there is a way to speed up the
process, I've tried Application.Screenupdating = True/False, but it seems to
take longer using this.
==
If oFolder.Files.Count > 0 Then
For Each oFile In oFolder.Files
If oFile.Type = filetype Then
sFile = Mid(oFile.Path, 1)
'Start of first value iPos1 =
InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\")
'End of first value and start of second value
iPos2 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\")
'End of second value and start of third value
iPos3 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\") + 1, sFile, "\")
'End of third value
iPos4 = InStrRev(sFile, "\")

'first string
Cells(iFile, iPathColA).Value = Mid(sFile, iPos1 + 1, iPos2 - iPos1)
Cells(iFile, iPathColB).Value = Mid(sFile, iPos2 + 1, iPos3 - iPos2)
Cells(iFile, iPathColC).Value = Mid(sFile, iPos3 + 1, iPos4 - iPos3)
Cells(iFile, iFileCol) = oFile.Name
' And a link in the Hyperlink column
Cells(iFile, iLinkCol).FormulaR1C1 = "=HYPERLINK(root &
RC[-4] & RC[-3]& RC[-2] & RC[-1] ,""HERE"")"
iFile = iFile + 1
End If
Next oFile
End If
 
N

NickHK

Instead of using all those Instr's, use Split

Dim sFile As String
Dim PathParts() As String
Dim Temp As String

sFile = oFile.Path

PathParts = Split(sFile, "\")

Cells(iFile, iPathColA).Value = PathParts(0) & "\"
Cells(iFile, iPathColB).Value = PathParts(1) & "\"
Temp = Mid(sFile, Len(PathParts(0)) + Len(PathParts(1)) + 3)
Cells(iFile, iPathColC).Value = Left(Temp, Len(Temp) -
Len(PathParts(UBound(PathParts))))

NickHK
 
T

Tom Ogilvy

Old news - suggested in response to a previous post. of course the spec
was a little bit different then.

Maybe he will like it better when you suggest it.

--
Regards,
Tom Ogilvy

NickHK said:
Instead of using all those Instr's, use Split

Dim sFile As String
Dim PathParts() As String
Dim Temp As String

sFile = oFile.Path

PathParts = Split(sFile, "\")

Cells(iFile, iPathColA).Value = PathParts(0) & "\"
Cells(iFile, iPathColB).Value = PathParts(1) & "\"
Temp = Mid(sFile, Len(PathParts(0)) + Len(PathParts(1)) + 3)
Cells(iFile, iPathColC).Value = Left(Temp, Len(Temp) -
Len(PathParts(UBound(PathParts))))

NickHK

dd said:
I have a file index, which inputs the paths in various columns for
Autofiltering and makes the files into hyperlinks. It takes a while to
process (22 rows takes approx 2 mins to process). There will be more
files
added as work proceeds. I want to know if there is a way to speed up the
process, I've tried Application.Screenupdating = True/False, but it seems to
take longer using this.
==
If oFolder.Files.Count > 0 Then
For Each oFile In oFolder.Files
If oFile.Type = filetype Then

sFile = Mid(oFile.Path, 1)

'Start of first value iPos1 =
InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\")
'End of first value and start of second value
iPos2 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1,
sFile,
"\") + 1, sFile, "\")
'End of second value and start of third value
iPos3 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1,
sFile,
"\") + 1, sFile, "\") + 1, sFile, "\")
'End of third value
iPos4 = InStrRev(sFile, "\")

'first string
Cells(iFile, iPathColA).Value = Mid(sFile, iPos1 + 1, iPos2 - iPos1)

Cells(iFile, iPathColB).Value = Mid(sFile, iPos2 + 1, iPos3 - iPos2)

Cells(iFile, iPathColC).Value = Mid(sFile, iPos3 + 1, iPos4 - iPos3)

Cells(iFile, iFileCol) = oFile.Name

' And a link in the Hyperlink column
Cells(iFile, iLinkCol).FormulaR1C1 = "=HYPERLINK(root &
RC[-4] & RC[-3]& RC[-2] & RC[-1] ,""HERE"")"

iFile = iFile + 1
End If
Next oFile
End If
Click to expand...
Click to expand...
 
N

NickHK

Tom,
I'm behind the times as usual <g>.

NickHK

Tom Ogilvy said:
Old news - suggested in response to a previous post. of course the spec
was a little bit different then.

Maybe he will like it better when you suggest it.

--
Regards,
Tom Ogilvy

NickHK said:
Instead of using all those Instr's, use Split

Dim sFile As String
Dim PathParts() As String
Dim Temp As String

sFile = oFile.Path

PathParts = Split(sFile, "\")

Cells(iFile, iPathColA).Value = PathParts(0) & "\"
Cells(iFile, iPathColB).Value = PathParts(1) & "\"
Temp = Mid(sFile, Len(PathParts(0)) + Len(PathParts(1)) + 3)
Cells(iFile, iPathColC).Value = Left(Temp, Len(Temp) -
Len(PathParts(UBound(PathParts))))

NickHK

dd said:
I have a file index, which inputs the paths in various columns for
Autofiltering and makes the files into hyperlinks. It takes a while to
process (22 rows takes approx 2 mins to process). There will be more
files
added as work proceeds. I want to know if there is a way to speed up the
process, I've tried Application.Screenupdating = True/False, but it
Click to expand...
seems
to
take longer using this.
==
If oFolder.Files.Count > 0 Then
For Each oFile In oFolder.Files
If oFile.Type = filetype Then

sFile = Mid(oFile.Path, 1)

'Start of first value iPos1 =
InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\")
'End of first value and start of second value
iPos2 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1,
sFile,
"\") + 1, sFile, "\")
'End of second value and start of third value
iPos3 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\")
Click to expand...
+
1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1,
sFile,
"\") + 1, sFile, "\") + 1, sFile, "\")
'End of third value
iPos4 = InStrRev(sFile, "\")

'first string
Cells(iFile, iPathColA).Value = Mid(sFile, iPos1 + 1, iPos2 - iPos1)

Cells(iFile, iPathColB).Value = Mid(sFile, iPos2 + 1, iPos3 - iPos2)

Cells(iFile, iPathColC).Value = Mid(sFile, iPos3 + 1, iPos4 - iPos3)

Cells(iFile, iFileCol) = oFile.Name

' And a link in the Hyperlink column
Cells(iFile, iLinkCol).FormulaR1C1 = "=HYPERLINK(root &
RC[-4] & RC[-3]& RC[-2] & RC[-1] ,""HERE"")"

iFile = iFile + 1
End If
Next oFile
End If
Click to expand...
Click to expand...
Click to expand...
 
D

dd

Tom,

I'm not as clever as you guys. I went for the MID() solution, as it was
already used in the code I had been given.
I had a go at incorporating the Split(s,"\") solution and have managed to
get the first two columns the way I want them. I've also included
application.Calculation = xlManual as advised. However, I don't notice that
much of a speed difference. Perhaps it's the network that is slowing things
down.

Regards
Dylan

PS Thanks to Tom and Nick HK for providing answers to this question.

Old news - suggested in response to a previous post. of course the spec
was a little bit different then.

Maybe he will like it better when you suggest it.

--
Regards,
Tom Ogilvy

NickHK said:
Instead of using all those Instr's, use Split

Dim sFile As String
Dim PathParts() As String
Dim Temp As String

sFile = oFile.Path

PathParts = Split(sFile, "\")

Cells(iFile, iPathColA).Value = PathParts(0) & "\"
Cells(iFile, iPathColB).Value = PathParts(1) & "\"
Temp = Mid(sFile, Len(PathParts(0)) + Len(PathParts(1)) + 3)
Cells(iFile, iPathColC).Value = Left(Temp, Len(Temp) -
Len(PathParts(UBound(PathParts))))

NickHK

dd said:
I have a file index, which inputs the paths in various columns for
Autofiltering and makes the files into hyperlinks. It takes a while to
process (22 rows takes approx 2 mins to process). There will be more
files
added as work proceeds. I want to know if there is a way to speed up the
process, I've tried Application.Screenupdating = True/False, but it seems to
take longer using this.
==
If oFolder.Files.Count > 0 Then
For Each oFile In oFolder.Files
If oFile.Type = filetype Then

sFile = Mid(oFile.Path, 1)

'Start of first value iPos1 =
InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1, sFile, "\") + 1, sFile,
"\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\")
'End of first value and start of second value
iPos2 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1,
sFile,
"\") + 1, sFile, "\")
'End of second value and start of third value
iPos3 = InStr(InStr(InStr(InStr(InStr(InStr(InStr(InStr(sFile, "\") + 1,
sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1, sFile, "\") + 1,
sFile,
"\") + 1, sFile, "\") + 1, sFile, "\")
'End of third value
iPos4 = InStrRev(sFile, "\")

'first string
Cells(iFile, iPathColA).Value = Mid(sFile, iPos1 + 1, iPos2 - iPos1)

Cells(iFile, iPathColB).Value = Mid(sFile, iPos2 + 1, iPos3 - iPos2)

Cells(iFile, iPathColC).Value = Mid(sFile, iPos3 + 1, iPos4 - iPos3)

Cells(iFile, iFileCol) = oFile.Name

' And a link in the Hyperlink column
Cells(iFile, iLinkCol).FormulaR1C1 = "=HYPERLINK(root &
RC[-4] & RC[-3]& RC[-2] & RC[-1] ,""HERE"")"

iFile = iFile + 1
End If
Next oFile
End If
Click to expand...
Click to expand...
 
D

dd

Nick

I wonder if you can help me with the data in Column C

With the following snippet of code, I want the ..iPathColC).Value to equal
the path string between PathParts(8) and the filename:

That is, for the path:
P:\GB123\Rail\Jobs\Feb06\Surveys\Trial surveys\Kyle of
Lochalsh\Station\Proforma\Part01\Station 01.pfm, I want to extract \Proforma
and any other directories before the filename into the ... iPAthColC).Value


sFile = oFile.Path

PathParts = Split(sFile, "\")

Cells(iFile, iPathColA).Value = PathParts(6) & "\"
Cells(iFile, iPathColB).Value = PathParts(7) & "\"

Temp = Mid(sFile, Len(PathParts(6)) + Len(PathParts(7)))
Cells(iFile, iPathColC).Value = Left(Temp, Len(Temp) -
Len(PathParts(UBound(PathParts))))

Cells(iFile, iFileCol) = oFile.Name

Regards
D Dawson
 
N

NickHK

As you seems to have many requirements, it would be better to make a
function to get the parts, instead of repeating split/combine code.
Something like this below. Note you should add error handling:

Public Function GetPathParts(FullPath As String, _
ByVal StartPart As Long, _
ByVal EndPart As Long) _
As String

Dim i As Long
Dim PathParts() As String
Dim TempStr As String

PathParts = Split(FullPath, "\")

If StartPart < 0 Then
StartPart = UBound(PathParts) + StartPart
ElseIf StartPart > 0 Then
StartPart = StartPart - 1
Else
GetPathParts = "Invalid StartPart"
Exit Function
End If

If EndPart < 0 Then
EndPart = UBound(PathParts) + EndPart
ElseIf EndPart > 0 Then
EndPart = EndPart - 1
Else
EndPart = UBound(PathParts)
End If

For i = StartPart To EndPart
TempStr = TempStr & PathParts(i) & "\"
Next
If InStr(1, PathParts(EndPart), ".") > 0 Then TempStr = Left(TempStr,
Len(TempStr) - 1)

GetPathParts = TempStr

End Function

Note that a -ve StartPart/EndPart counts from the right, whilst zero goes to
the end. A little testing produced these results:

P:\GB123\Rail\Jobs\Feb06\Surveys\Trial surveys\Kyle of
Lochalsh\Station\Proforma\Part01\Station 01.pfm

Start End Returned
1 1 P:\
1 2 P:\GB123\
8 -1 Kyle of Lochalsh\Station\Proforma\Part01\
8 -2 Kyle of Lochalsh\Station\Proforma\
3 5 Rail\Jobs\Feb06\
3 0 Rail\Jobs\Feb06\Surveys\Trial surveys\Kyle of
Lochalsh\Station\Proforma\Part01\Station 01.pfm
1 0 P:\GB123\Rail\Jobs\Feb06\Surveys\Trial surveys\Kyle of
Lochalsh\Station\Proforma\Part01\Station 01.pfm
-3 -1 Station\Proforma\Part01\

NickHK
 
D

dd

NickHK

Thank you very much for your help with this.
The code you gave me works perfectly and your instructions were very
helpful.

Dylan Dawson
Scotland

As you seems to have many requirements, it would be better to make a
function to get the parts, instead of repeating split/combine code.
Something like this below. Note you should add error handling:

Public Function GetPathParts(FullPath As String, _
ByVal StartPart As Long, _
ByVal EndPart As Long) _
As String

Dim i As Long
Dim PathParts() As String
Dim TempStr As String

PathParts = Split(FullPath, "\")

If StartPart < 0 Then
StartPart = UBound(PathParts) + StartPart
ElseIf StartPart > 0 Then
StartPart = StartPart - 1
Else
GetPathParts = "Invalid StartPart"
Exit Function
End If

If EndPart < 0 Then
EndPart = UBound(PathParts) + EndPart
ElseIf EndPart > 0 Then
EndPart = EndPart - 1
Else
EndPart = UBound(PathParts)
End If

For i = StartPart To EndPart
TempStr = TempStr & PathParts(i) & "\"
Next
If InStr(1, PathParts(EndPart), ".") > 0 Then TempStr = Left(TempStr,
Len(TempStr) - 1)

GetPathParts = TempStr

End Function

Note that a -ve StartPart/EndPart counts from the right, whilst zero goes to
the end. A little testing produced these results:

P:\GB123\Rail\Jobs\Feb06\Surveys\Trial surveys\Kyle of
Lochalsh\Station\Proforma\Part01\Station 01.pfm

Start End Returned
1 1 P:\
1 2 P:\GB123\
8 -1 Kyle of Lochalsh\Station\Proforma\Part01\
8 -2 Kyle of Lochalsh\Station\Proforma\
3 5 Rail\Jobs\Feb06\
3 0 Rail\Jobs\Feb06\Surveys\Trial surveys\Kyle of
Lochalsh\Station\Proforma\Part01\Station 01.pfm
1 0 P:\GB123\Rail\Jobs\Feb06\Surveys\Trial surveys\Kyle of
Lochalsh\Station\Proforma\Part01\Station 01.pfm
-3 -1 Station\Proforma\Part01\

NickHK
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

word to excel 1
Macro to extract in string 4
How to stop the 'select sheet' window pop up 2
How to speed up my VBA application ? 1
Change delimiter in import function from comma to tab 1
speed up export to text 3
FileSystemWatcher advice required please 16

Top