"Jim Cone" wrote...
I quickly ran three speed tests using Timer on
l00,000 loops on the string provide by Francis..
For five trials the average time was

Function Foo: 0.92 seconds
Function LastPosition: 0.83 seconds
Function RevInStr: 0.65 seconds (using 99 as lngStart)
....

Not my results.

Redirecting the output of the console command

dir c:\ /s/b

to a text file and loading that text file into Excel 2000 without parsing, I
used the first 40,000 filenames and iterated over them 10 times, so 400,000
calls for each function.

Here are my results. For me, foo is much faster than LastPosition.

------------------------------
foo 10.028
foo2 8.022
LastPosition 34.094
RevInStr 6.017
InStrRev 1.003
findrev 1.003
==============================


And here's my testing module.

'---------------------------------------------------------------------
Sub testem()
Const MAXITER As Long = 10, NUMROWS As Long = 40000

Dim r As Range
Dim s() As String, p() As Long
Dim i As Long, j As Long
Dim dt As Date, et As Date

On Error GoTo ExitProc
Application.Calculation = xlCalculationManual

Set r = ActiveSheet.Range("A1").Resize(NUMROWS, 1)

ReDim s(1 To NUMROWS)
ReDim p(1 To NUMROWS, 1 To 1)

For i = 1 To NUMROWS
s(i) = r.Cells(i, 1).Value
Next i

Debug.Print String(30, "-")

dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = foo(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """foo ""0.000")

r.Offset(0, 2).Value = p

Erase p
ReDim p(1 To NUMROWS, 1 To 1)

dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = foo2(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """foo2 "" 0.000")

r.Offset(0, 4).Value = p

Erase p
ReDim p(1 To NUMROWS, 1 To 1)

dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = LastPosition(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """LastPosition ""0.000")

r.Offset(0, 6).Value = p

Erase p
ReDim p(1 To NUMROWS, 1 To 1)

dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = RevInStr(s(j), "\", 0)
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """RevInStr "" 0.000")

r.Offset(0, 8).Value = p

Erase p
ReDim p(1 To NUMROWS, 1 To 1)

dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = InStrRev(s(j), "\")
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """InStrRev "" 0.000")

r.Offset(0, 10).Value = p

Erase p
ReDim p(1 To NUMROWS, 1 To 1)

dt = Now
For i = 1 To MAXITER
For j = 1 To NUMROWS
p(j, 1) = findrev("\", s(j))
Next j
Next i
et = Now - dt
Debug.Print Format(et * 86640#, """findrev "" 0.000")

r.Offset(0, 12).Value = p

Debug.Print String(30, "=")

ExitProc:
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub


Function foo(s As String, ss As String) As Long
Dim k As Long, n As Long

k = Len(ss)
n = InStr(1, s, ss)

If n 0 Then
foo = Len(s) - k

Do
foo = foo - 1
Loop Until Mid(s, foo, k) = ss Or foo <= n
Else
foo = n

End If

End Function


Function foo2(s As String, ss As String) As Long
Dim k As Long, n As Long, p As Long

k = Len(ss)
n = Len(s) - k + 1

For p = n To 0 Step -1
If p 0 Then If Mid(s, p, k) = ss Then Exit For
Next p

foo2 = p
End Function


Function LastPosition( _
ByRef strInput As String, _
ByRef strChars As String _
) As Long
'Jim Cone - San Francisco - Sep 18, 2003
'ByVal allows variants to be used for the string variables
On Error GoTo WrongPosition
Dim lngPos As Long
Dim lngCnt As Long
Dim lngLength As Long

lngPos = 1
lngLength = Len(strChars)

Do
lngPos = InStr(lngPos, strInput, strChars, vbTextCompare)
If lngPos Then
lngCnt = lngPos
lngPos = lngPos + lngLength
End If
Loop While lngPos 0
LastPosition = lngCnt
Exit Function

WrongPosition:
Beep
LastPosition = 0
End Function


'----------------------------------------------------------------
' Searches for a character, but starting at the end of the string.
' strString is the string you want to search in
' strChar is the character or string of characters you want to search for
' lngStart is the position in TheString you want to start the search at.
'----------------------------------------------------------------
Function RevInStr( _
ByRef strString As String, _
ByRef strChar As String, _
ByVal lngStart As Long _
) As Long

Dim lngNdx As Long
Dim lngLength As Long

lngLength = Len(strChar)
'If strChar length 1 this reduces number of loops required
If lngStart <= 0 Or lngStart Len(strString) Then _
lngStart = Len(strString) - lngLength + 1

For lngNdx = lngStart To 1 Step -1
If Mid$(strString, lngNdx, lngLength) = strChar Then
RevInStr = lngNdx - 1
'or (lngNdx + lngLength) depending on which section
'you want
Exit For
End If
Next 'lngNdx
' In case nothing found or In case position found was 1 which
' would return 0.
If RevInStr = 0 Then RevInStr = 1
End Function


Function findrev(ss As String, s As String) As Long
findrev = InStrRev(s, ss)
End Function
'---------------------------------------------------------------------


Your RevInStr returns 1 less than all the other functions. I haven't
explored what might be needed to have it return the same values when there
are matches and 0 when there aren't. Returning 1 for both no match at all
and the only match at the beginning of strString is bad programming.

However, given the times for direct InStrRev and findrev, a simple wrapper
around InStrRev, I'll strengthen with my original statement to this: anyone
with VBA6 would a fool not to use VBA6's InStrRev.