Find nth instance of a character in a string

Jim Cone wrote...
>And the following gets you the position using code ...
>Function LastPosition(ByVal strInput As String, ByVal strChars As
String) As Long
....
>'Call it like this...
>Sub WhereIsIt()
>Dim N As Long
>N = LastPosition("http://www.theexceladdict.com/tutorials.htm", "/")
>MsgBox N
>End Sub
....

If one uses Excel 2000 or later, why this rather than a simple wrapper
around the InStrRev VBA6 function? If one uses Excel 5/95 or 97, why
not keep it simple?


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

Hi Harlan,

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)

The RevInStr function also comes from my private library :
'----------------------------------------------------------------
' 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
'-------------------------------------------------

Have I overlooked something?

Regards,
Jim Cone
San Francisco, USA


"Harlan Grove" <hrlngrv@aol.com> wrote in message
news:1106266786.285550.307270@c13g2000cwb.googlegroups.com...
> Jim Cone wrote...
> >And the following gets you the position using code ...
> >Function LastPosition(ByVal strInput As String, ByVal strChars As
> String) As Long
> ...
> >'Call it like this...
> >Sub WhereIsIt()
> >Dim N As Long
> >N = LastPosition("http://www.theexceladdict.com/tutorials.htm", "/")
> >MsgBox N
> >End Sub
> If one uses Excel 2000 or later, why this rather than a simple wrapper
> around the InStrRev VBA6 function? If one uses Excel 5/95 or 97, why
> not keep it simple?

> 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

"Jim Cone" <jim.coneXXX@rcn.comXXX> 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.

Harlan,

I used your testing module on the 4700 files in
my Program Files folder.
The full file path was used for each file.
I ran the test 100 times for a total of 470,000 calls.
I repeated each set 5 times and the results are...

Name Time
LastPosition Average 7.4202
foo Average 4.6128
foo2 Average 4.6128
RevInStr Average 3.4092
findrev Average 0.6018
InStrRev Average 0.6018


Regards,
Jim Cone
San Francisco, USA


"Harlan Grove" <hrlngrv@aol.com> wrote in message
news:uxO8UN5$EHA.3120@TK2MSFTNGP12.phx.gbl...
> "Jim Cone" <jim.coneXXX@rcn.comXXX> 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
> ==============================
-snip-