Turn InStr(w, x, y, z) into InStr(w, x1, y1, vbBinaryCompare) ?

[Joe \Nuke Me Xemu\ Foster]

I've recently been mucking about with string code that involves
repeatedly calling InStr with essentially the same arguments. This
may be OK when Compare is vbBinaryCompare, but it sucks when it's
anything else! So, is there a decent way to transform calls like
this, InStr(w, x, y, z), where z <> vbBinaryCompare, into calls more
like InStr(w, x1, y1, vbBinaryCompare) ? Here's my test code, which
fails even on "A":

Sub TestStrMangle(Optional ByVal z As VbCompareMethod = vbTextCompare)
Dim x As String: x = Space$(65536)
Dim i As Long: For i = 0 To 65535
Mid$(x, i + 1) = ChrW$(i)
Next

Dim x1 As String: x1 = UCase$(x) ' TODO: use a transformation that works

For i = 0 To 65535
If (i And 255) = 0 Then Debug.Print i;
Dim y As String: y = ChrW$(i)
Dim y1 As String: y1 = UCase$(y) ' TODO: use a transformation that works
Dim w As Long: w = 1
Do
Dim p0 As Long: p0 = InStr(w, x, y, z)
Dim p1 As Long: p1 = InStr(w, x1, y1, vbBinaryCompare)
If p0 <> p1 Then
Debug.Print vbNewLine; "i ="; i; "w ="; w; "p0 ="; p0; "p1 ="; p1
Stop
End If
w = p0 + 1
Loop While p0
Next
End Sub

--
Joe Foster <mailto:jlfoster%40znet.com> Space Cooties! <http://www.xenu.net/>
WARNING: I cannot be held responsible for the above They're coming to
because my cats have apparently learned to type. take me away, ha ha!

[Michael \(michka\) Kaplan]

The EASIEST way is to define your own public InStr function in a module:

Public Function InStr( _
ByVal Start As Variant, _
ByVal String1 As Variant, _
Optional ByVal string2 As Variant, _
Optional Compare As VbCompareMethod = vbBinaryCompare _
) As Variant

If IsMissing(string2) Then
InStr = VBA.InStr(1, Start, String1, Compare)
Else
InStr = VBA.InStr(Start, String1, string2, Compare)
End If
End Function


This function will now always be called instead of the original.



--
MichKa

Michael Kaplan
(principal developer of the MSLU)
Trigeminal Software, Inc. -- http://www.trigeminal.com/
the book -- http://www.i18nWithVB.com/

"Joe "Nuke Me Xemu" Foster" <joe@bftsi0.UUCP> wrote in message
news:3c1c1dee@147.208.176.211...
> I've recently been mucking about with string code that involves
> repeatedly calling InStr with essentially the same arguments. This
> may be OK when Compare is vbBinaryCompare, but it sucks when it's
> anything else! So, is there a decent way to transform calls like
> this, InStr(w, x, y, z), where z <> vbBinaryCompare, into calls more
> like InStr(w, x1, y1, vbBinaryCompare) ? Here's my test code, which
> fails even on "A":
>
> Sub TestStrMangle(Optional ByVal z As VbCompareMethod = vbTextCompare)
> Dim x As String: x = Space$(65536)
> Dim i As Long: For i = 0 To 65535
> Mid$(x, i + 1) = ChrW$(i)
> Next
>
> Dim x1 As String: x1 = UCase$(x) ' TODO: use a transformation that works
>
> For i = 0 To 65535
> If (i And 255) = 0 Then Debug.Print i;
> Dim y As String: y = ChrW$(i)
> Dim y1 As String: y1 = UCase$(y) ' TODO: use a transformation that
works
> Dim w As Long: w = 1
> Do
> Dim p0 As Long: p0 = InStr(w, x, y, z)
> Dim p1 As Long: p1 = InStr(w, x1, y1, vbBinaryCompare)
> If p0 <> p1 Then
> Debug.Print vbNewLine; "i ="; i; "w ="; w; "p0 ="; p0; "p1 ="; p1
> Stop
> End If
> w = p0 + 1
> Loop While p0
> Next
> End Sub
>
> --
> Joe Foster <mailto:jlfoster%40znet.com> Space Cooties!
<http://www.xenu.net/>
> WARNING: I cannot be held responsible for the above They're
coming to
> because my cats have apparently learned to type. take me away,
ha ha!
>
>

[Michael \(michka\) Kaplan]

The EASIEST way is to define your own public InStr function in a module:

Public Function InStr( _
ByVal Start As Variant, _
ByVal String1 As Variant, _
Optional ByVal string2 As Variant, _
Optional Compare As VbCompareMethod = vbBinaryCompare _
) As Variant

If IsMissing(string2) Then
InStr = VBA.InStr(1, Start, String1, Compare)
Else
InStr = VBA.InStr(Start, String1, string2, Compare)
End If
End Function


This function will now always be called instead of the original.



--
MichKa

Michael Kaplan
(principal developer of the MSLU)
Trigeminal Software, Inc. -- http://www.trigeminal.com/
the book -- http://www.i18nWithVB.com/

"Joe "Nuke Me Xemu" Foster" <joe@bftsi0.UUCP> wrote in message
news:3c1c1dee@147.208.176.211...
> I've recently been mucking about with string code that involves
> repeatedly calling InStr with essentially the same arguments. This
> may be OK when Compare is vbBinaryCompare, but it sucks when it's
> anything else! So, is there a decent way to transform calls like
> this, InStr(w, x, y, z), where z <> vbBinaryCompare, into calls more
> like InStr(w, x1, y1, vbBinaryCompare) ? Here's my test code, which
> fails even on "A":
>
> Sub TestStrMangle(Optional ByVal z As VbCompareMethod = vbTextCompare)
> Dim x As String: x = Space$(65536)
> Dim i As Long: For i = 0 To 65535
> Mid$(x, i + 1) = ChrW$(i)
> Next
>
> Dim x1 As String: x1 = UCase$(x) ' TODO: use a transformation that works
>
> For i = 0 To 65535
> If (i And 255) = 0 Then Debug.Print i;
> Dim y As String: y = ChrW$(i)
> Dim y1 As String: y1 = UCase$(y) ' TODO: use a transformation that
works
> Dim w As Long: w = 1
> Do
> Dim p0 As Long: p0 = InStr(w, x, y, z)
> Dim p1 As Long: p1 = InStr(w, x1, y1, vbBinaryCompare)
> If p0 <> p1 Then
> Debug.Print vbNewLine; "i ="; i; "w ="; w; "p0 ="; p0; "p1 ="; p1
> Stop
> End If
> w = p0 + 1
> Loop While p0
> Next
> End Sub
>
> --
> Joe Foster <mailto:jlfoster%40znet.com> Space Cooties!
<http://www.xenu.net/>
> WARNING: I cannot be held responsible for the above They're
coming to
> because my cats have apparently learned to type. take me away,
ha ha!
>
>

[Joe \Nuke Me Xemu\ Foster]

"Michael (michka) Kaplan" <former_mvp@nospam.trigeminal.spamless.com> wrote in message <news:3c1d316d@147.208.176.211>...

> The EASIEST way is to define your own public InStr function in a module:

Unfortunately, that isn't at all what I was asking. Let's say I'm calling
InStr repeatedly with the same strings, to find all occurrences of y in x:

dim result() as long, rcount as long, pos as long
redim result(0 to 15)
do
pos = instr(pos + 1, x, y, vbtextcompare)
if pos = 0 then exit do
if rcount > ubound(result) then redim preserve result(0 to rcount * 2)
result(rcount) = pos
rcount = rcount + 1
loop

Now, I've noticed that calling instr with any compare method other than
vbbinarycompare is damned slow, as if instr is converting the strings
somehow before starting its search when the compare method is anything
other than vbbinarycompare. Is there a way I can do this conversion
myself, in order to save instr from having to spin its wheels like that?
My first stab at doing this looked something like this:

' InStr is slow when used with a compare method other than vbBinaryCompare!
' However, is InStr(S, S1, S2, 1) always equivalent to InStr(S, LCase$(S1), LCase$(S2), 0)?
If Compare = vbTextCompare Then
StringCheck = LCase$(StringCheck)
StringMatch = LCase$(StringMatch)
Compare = vbBinaryCompare
End If

Obviously, this won't really work. Remember, the code later on repeatedly
calls instr with these same strings and compare method. Is there something
that *will* work, as verified by the code in my original post? Is there a
way to do this when Compare is a locale ID or perhaps even a Field object's
CollatingOrder property?

--
Joe Foster <mailto:jlfoster%40znet.com> Sacrament R2-45 <http://www.xenu.net/>
WARNING: I cannot be held responsible for the above They're coming to
because my cats have apparently learned to type. take me away, ha ha!

[Joe \Nuke Me Xemu\ Foster]

"Michael (michka) Kaplan" <former_mvp@nospam.trigeminal.spamless.com> wrote in message <news:3c1d316d@147.208.176.211>...

> The EASIEST way is to define your own public InStr function in a module:

Unfortunately, that isn't at all what I was asking. Let's say I'm calling
InStr repeatedly with the same strings, to find all occurrences of y in x:

dim result() as long, rcount as long, pos as long
redim result(0 to 15)
do
pos = instr(pos + 1, x, y, vbtextcompare)
if pos = 0 then exit do
if rcount > ubound(result) then redim preserve result(0 to rcount * 2)
result(rcount) = pos
rcount = rcount + 1
loop

Now, I've noticed that calling instr with any compare method other than
vbbinarycompare is damned slow, as if instr is converting the strings
somehow before starting its search when the compare method is anything
other than vbbinarycompare. Is there a way I can do this conversion
myself, in order to save instr from having to spin its wheels like that?
My first stab at doing this looked something like this:

' InStr is slow when used with a compare method other than vbBinaryCompare!
' However, is InStr(S, S1, S2, 1) always equivalent to InStr(S, LCase$(S1), LCase$(S2), 0)?
If Compare = vbTextCompare Then
StringCheck = LCase$(StringCheck)
StringMatch = LCase$(StringMatch)
Compare = vbBinaryCompare
End If

Obviously, this won't really work. Remember, the code later on repeatedly
calls instr with these same strings and compare method. Is there something
that *will* work, as verified by the code in my original post? Is there a
way to do this when Compare is a locale ID or perhaps even a Field object's
CollatingOrder property?

--
Joe Foster <mailto:jlfoster%40znet.com> Sacrament R2-45 <http://www.xenu.net/>
WARNING: I cannot be held responsible for the above They're coming to
because my cats have apparently learned to type. take me away, ha ha!

[Michael \(michka\) Kaplan]

No, there is no way to do this, using InStr.


--
MichKa

Michael Kaplan
(principal developer of the MSLU)
Trigeminal Software, Inc. -- http://www.trigeminal.com/
the book -- http://www.i18nWithVB.com/


"Joe "Nuke Me Xemu" Foster" <joe@bftsi0.UUCP> wrote in message
news:3c1d513e@147.208.176.211...
> "Michael (michka) Kaplan" <former_mvp@nospam.trigeminal.spamless.com>
wrote in message <news:3c1d316d@147.208.176.211>...
>
> > The EASIEST way is to define your own public InStr function in a module:
>
> Unfortunately, that isn't at all what I was asking. Let's say I'm calling
> InStr repeatedly with the same strings, to find all occurrences of y in x:
>
> dim result() as long, rcount as long, pos as long
> redim result(0 to 15)
> do
> pos = instr(pos + 1, x, y, vbtextcompare)
> if pos = 0 then exit do
> if rcount > ubound(result) then redim preserve result(0 to rcount * 2)
> result(rcount) = pos
> rcount = rcount + 1
> loop
>
> Now, I've noticed that calling instr with any compare method other than
> vbbinarycompare is damned slow, as if instr is converting the strings
> somehow before starting its search when the compare method is anything
> other than vbbinarycompare. Is there a way I can do this conversion
> myself, in order to save instr from having to spin its wheels like that?
> My first stab at doing this looked something like this:
>
> ' InStr is slow when used with a compare method other than
vbBinaryCompare!
> ' However, is InStr(S, S1, S2, 1) always equivalent to InStr(S,
LCase$(S1), LCase$(S2), 0)?
> If Compare = vbTextCompare Then
> StringCheck = LCase$(StringCheck)
> StringMatch = LCase$(StringMatch)
> Compare = vbBinaryCompare
> End If
>
> Obviously, this won't really work. Remember, the code later on repeatedly
> calls instr with these same strings and compare method. Is there
something
> that *will* work, as verified by the code in my original post? Is there a
> way to do this when Compare is a locale ID or perhaps even a Field
object's
> CollatingOrder property?
>
> --
> Joe Foster <mailto:jlfoster%40znet.com> Sacrament R2-45
<http://www.xenu.net/>
> WARNING: I cannot be held responsible for the above They're
coming to
> because my cats have apparently learned to type. take me away,
ha ha!
>
>

[Michael \(michka\) Kaplan]

No, there is no way to do this, using InStr.


--
MichKa

Michael Kaplan
(principal developer of the MSLU)
Trigeminal Software, Inc. -- http://www.trigeminal.com/
the book -- http://www.i18nWithVB.com/


"Joe "Nuke Me Xemu" Foster" <joe@bftsi0.UUCP> wrote in message
news:3c1d513e@147.208.176.211...
> "Michael (michka) Kaplan" <former_mvp@nospam.trigeminal.spamless.com>
wrote in message <news:3c1d316d@147.208.176.211>...
>
> > The EASIEST way is to define your own public InStr function in a module:
>
> Unfortunately, that isn't at all what I was asking. Let's say I'm calling
> InStr repeatedly with the same strings, to find all occurrences of y in x:
>
> dim result() as long, rcount as long, pos as long
> redim result(0 to 15)
> do
> pos = instr(pos + 1, x, y, vbtextcompare)
> if pos = 0 then exit do
> if rcount > ubound(result) then redim preserve result(0 to rcount * 2)
> result(rcount) = pos
> rcount = rcount + 1
> loop
>
> Now, I've noticed that calling instr with any compare method other than
> vbbinarycompare is damned slow, as if instr is converting the strings
> somehow before starting its search when the compare method is anything
> other than vbbinarycompare. Is there a way I can do this conversion
> myself, in order to save instr from having to spin its wheels like that?
> My first stab at doing this looked something like this:
>
> ' InStr is slow when used with a compare method other than
vbBinaryCompare!
> ' However, is InStr(S, S1, S2, 1) always equivalent to InStr(S,
LCase$(S1), LCase$(S2), 0)?
> If Compare = vbTextCompare Then
> StringCheck = LCase$(StringCheck)
> StringMatch = LCase$(StringMatch)
> Compare = vbBinaryCompare
> End If
>
> Obviously, this won't really work. Remember, the code later on repeatedly
> calls instr with these same strings and compare method. Is there
something
> that *will* work, as verified by the code in my original post? Is there a
> way to do this when Compare is a locale ID or perhaps even a Field
object's
> CollatingOrder property?
>
> --
> Joe Foster <mailto:jlfoster%40znet.com> Sacrament R2-45
<http://www.xenu.net/>
> WARNING: I cannot be held responsible for the above They're
coming to
> because my cats have apparently learned to type. take me away,
ha ha!
>
>

[Joe \Nuke Me Xemu\ Foster]

"Michael (michka) Kaplan" <former_mvp@nospam.trigeminal.spamless.com> wrote in message <news:3c1d5a10$1@147.208.176.211>...

> No, there is no way to do this, using InStr.

I thought I almost had something, based on a sort of bastardized Boyer-
Moore string search, but then I ran into "ae" and "æ" a/k/a chr$(230),
and who knows what other gotchas are out there in Unicode-land... =(
Of course, all such concerns will go away in TEOVBAWKI.NET, right?

Here's what I have so far. When it does work, it can blow the doors
off of an equivalent function which uses only InStr in a loop. Oh well,
maybe someone can salvage something useful from the wreckage:

Function InStrAllEx(ByVal StringCheck As String, ByVal StringMatch As String, _
Optional ByVal Start As Long = 1, Optional ByVal Limit As Long = -1, _
Optional ByVal Overlaps As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Variant

Dim LSC As Long: LSC = Len(StringCheck)
Dim LSM As Long: LSM = Len(StringMatch)
Dim Result() As Long, RCount As Long

' greasy Split/Replace compatibility stuff
If Limit < -1 Or Start < 1 Then
Err.Raise 5
ElseIf LSM = 0 Then
ReDim Result(0 To 0)
Result(0) = Start
InStrAllEx = Result
Exit Function
ElseIf LSC = 0 Or Limit = 0 Then
InStrAllEx = Array()
Exit Function
End If

Static Chars As String
Dim i As Long, j As Long, K As Long, C As String

' initialize our character table
If Len(Chars) = 0 Then
Chars = Space$(256)
For K = 1 To 256
Mid$(Chars, K) = Chr$(K - 1)
Next
End If

' construct something like a Boyer-Moore skip table
Dim Positions(0 To 255) As Long
For i = 1 To LSM
C = Mid$(StringMatch, i, 1)
K = InStr(1, Chars, C, Compare)
Do
Positions(K - 1) = i
K = InStr(K + 1, Chars, C, Compare)
Loop While K
Next

If Limit < 1 Or Limit > 1000 Then ReDim Result(0 To 15) _
Else ReDim Result(0 To Limit - 1)

Dim Stride As Long: If Overlaps Then Stride = 1 Else Stride = LSM
Start = Start - 1 + LSM
Do
If Start > LSC Then Exit Do
'Debug.Print Start;
i = Positions(Asc(Mid$(StringCheck, Start, 1)))
If i = 0 Then
' current character is not within StringMatch
Start = Start + LSM
Else ' we have a match on at least one character
i = Start - i + 1 ' start of leftmost possible match
j = i - 1 + LSM ' end of leftmost possible match

' is the last character of StringMatch at end of the possible match?
If j = Start Then
' we're already at the end of the possible match
K = LSM
ElseIf j > LSC Then
' end of leftmost possible match is past end of StringCheck!
Exit Do
Else
K = Positions(Asc(Mid$(StringCheck, j, 1)))
End If

If K = 0 Then
' end of possible match not within StringMatch at all
Start = j + LSM
ElseIf K <> LSM Then
' EoPM is some other character within StringMatch
Start = j + 1
ElseIf InStr(1, Mid$(StringCheck, i, LSM), StringMatch, Compare) <> 1 Then
' the rest of the characters don't match
Start = j + 1
Else
' we have a match!
If RCount > UBound(Result) Then ReDim Preserve Result(0 To RCount * 2)
Result(RCount) = i
RCount = RCount + 1
If Limit <> 1 Then Limit = Limit - 1 Else Exit Do
Start = j + Stride
End If
End If
Loop

If RCount = 0 Then
InStrAllEx = Array()
Else
ReDim Preserve Result(0 To RCount - 1)
InStrAllEx = Result
End If
End Function

Here's the InStr-in-a-loop reference version:

Function InStrAll(ByVal StringCheck As String, ByVal StringMatch As String, _
Optional ByVal Start As Long = 1, Optional ByVal Limit As Long = -1, _
Optional ByVal Overlaps As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Variant

Dim LSC As Long: LSC = Len(StringCheck)
Dim LSM As Long: LSM = Len(StringMatch)
Dim Result() As Long, RCount As Long

' greasy Split/Replace compatibility stuff
If Limit < -1 Or Start < 1 Then
Err.Raise 5
ElseIf LSM = 0 Then
ReDim Result(0 To 0)
Result(0) = Start
InStrAll = Result
Exit Function
ElseIf LSC = 0 Or Limit = 0 Then
InStrAll = Array()
Exit Function
End If

If Limit < 1 Or Limit > 1000 Then ReDim Result(0 To 15) _
Else ReDim Result(0 To Limit - 1)

Dim Stride As Long: If Overlaps Then Stride = 1 Else Stride = LSM
Do
Start = InStr(Start, StringCheck, StringMatch, Compare)
If Start = 0 Then Exit Do

If RCount > UBound(Result) Then ReDim Preserve Result(0 To RCount * 2)
Result(RCount) = Start
RCount = RCount + 1

If Limit <> 1 Then Limit = Limit - 1 Else Exit Do
Start = Start + Stride
Loop

If RCount = 0 Then
InStrAll = Array()
Else
ReDim Preserve Result(0 To RCount - 1)
InStrAll = Result
End If
End Function

Here's the test harness:

Declare Function timeGetTime Lib "WinMM" () As Long
Declare Function timeBeginPeriod Lib "WinMM" (ByVal p As Long) As Long
Declare Function timeEndPeriod Lib "WinMM" (ByVal p As Long) As Long

Function StringXP(ByVal Number As Long, ByVal What As String) As String
StringXP = Space$(Number * Len(What))
Mid$(StringXP, 1) = What
Mid$(StringXP, Len(What) + 1) = StringXP
End Function

Sub InStrTest()
Dim sc As String: sc = StringXP(1000, "Supercalifragilisticexpialidocious")
Dim sm As String: sm = "SuperSoaker"
Mid$(sc, Len(sc) - 100) = "SupersoaKeR"

Const Compare = vbTextCompare

timeBeginPeriod 1

Dim t0 As Long: t0 = timeGetTime
Dim r0 As Variant: r0 = InStrAllEx(sc, sm, , , , Compare)
t0 = timeGetTime - t0

Debug.Print UBound(r0) - LBound(r0) + 1; "matches in"; t0;

Dim t1 As Long: t1 = timeGetTime
Dim r1 As Variant: r1 = InStrAll(sc, sm, , , , Compare)
t1 = timeGetTime - t1

timeEndPeriod 1

Debug.Print t1

Debug.Assert LBound(r0) = LBound(r1) And UBound(r0) = UBound(r1)
Dim i As Long: For i = LBound(r0) To UBound(r0)
Debug.Assert r0(i) = r1(i)
Next
End Sub

--
Joe Foster <mailto:jlfoster%40znet.com> On the cans? <http://www.xenu.net/>
WARNING: I cannot be held responsible for the above They're coming to
because my cats have apparently learned to type. take me away, ha ha!

[Joe \Nuke Me Xemu\ Foster]

"Michael (michka) Kaplan" <former_mvp@nospam.trigeminal.spamless.com> wrote in message <news:3c1d5a10$1@147.208.176.211>...

> No, there is no way to do this, using InStr.

I thought I almost had something, based on a sort of bastardized Boyer-
Moore string search, but then I ran into "ae" and "æ" a/k/a chr$(230),
and who knows what other gotchas are out there in Unicode-land... =(
Of course, all such concerns will go away in TEOVBAWKI.NET, right?

Here's what I have so far. When it does work, it can blow the doors
off of an equivalent function which uses only InStr in a loop. Oh well,
maybe someone can salvage something useful from the wreckage:

Function InStrAllEx(ByVal StringCheck As String, ByVal StringMatch As String, _
Optional ByVal Start As Long = 1, Optional ByVal Limit As Long = -1, _
Optional ByVal Overlaps As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Variant

Dim LSC As Long: LSC = Len(StringCheck)
Dim LSM As Long: LSM = Len(StringMatch)
Dim Result() As Long, RCount As Long

' greasy Split/Replace compatibility stuff
If Limit < -1 Or Start < 1 Then
Err.Raise 5
ElseIf LSM = 0 Then
ReDim Result(0 To 0)
Result(0) = Start
InStrAllEx = Result
Exit Function
ElseIf LSC = 0 Or Limit = 0 Then
InStrAllEx = Array()
Exit Function
End If

Static Chars As String
Dim i As Long, j As Long, K As Long, C As String

' initialize our character table
If Len(Chars) = 0 Then
Chars = Space$(256)
For K = 1 To 256
Mid$(Chars, K) = Chr$(K - 1)
Next
End If

' construct something like a Boyer-Moore skip table
Dim Positions(0 To 255) As Long
For i = 1 To LSM
C = Mid$(StringMatch, i, 1)
K = InStr(1, Chars, C, Compare)
Do
Positions(K - 1) = i
K = InStr(K + 1, Chars, C, Compare)
Loop While K
Next

If Limit < 1 Or Limit > 1000 Then ReDim Result(0 To 15) _
Else ReDim Result(0 To Limit - 1)

Dim Stride As Long: If Overlaps Then Stride = 1 Else Stride = LSM
Start = Start - 1 + LSM
Do
If Start > LSC Then Exit Do
'Debug.Print Start;
i = Positions(Asc(Mid$(StringCheck, Start, 1)))
If i = 0 Then
' current character is not within StringMatch
Start = Start + LSM
Else ' we have a match on at least one character
i = Start - i + 1 ' start of leftmost possible match
j = i - 1 + LSM ' end of leftmost possible match

' is the last character of StringMatch at end of the possible match?
If j = Start Then
' we're already at the end of the possible match
K = LSM
ElseIf j > LSC Then
' end of leftmost possible match is past end of StringCheck!
Exit Do
Else
K = Positions(Asc(Mid$(StringCheck, j, 1)))
End If

If K = 0 Then
' end of possible match not within StringMatch at all
Start = j + LSM
ElseIf K <> LSM Then
' EoPM is some other character within StringMatch
Start = j + 1
ElseIf InStr(1, Mid$(StringCheck, i, LSM), StringMatch, Compare) <> 1 Then
' the rest of the characters don't match
Start = j + 1
Else
' we have a match!
If RCount > UBound(Result) Then ReDim Preserve Result(0 To RCount * 2)
Result(RCount) = i
RCount = RCount + 1
If Limit <> 1 Then Limit = Limit - 1 Else Exit Do
Start = j + Stride
End If
End If
Loop

If RCount = 0 Then
InStrAllEx = Array()
Else
ReDim Preserve Result(0 To RCount - 1)
InStrAllEx = Result
End If
End Function

Here's the InStr-in-a-loop reference version:

Function InStrAll(ByVal StringCheck As String, ByVal StringMatch As String, _
Optional ByVal Start As Long = 1, Optional ByVal Limit As Long = -1, _
Optional ByVal Overlaps As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Variant

Dim LSC As Long: LSC = Len(StringCheck)
Dim LSM As Long: LSM = Len(StringMatch)
Dim Result() As Long, RCount As Long

' greasy Split/Replace compatibility stuff
If Limit < -1 Or Start < 1 Then
Err.Raise 5
ElseIf LSM = 0 Then
ReDim Result(0 To 0)
Result(0) = Start
InStrAll = Result
Exit Function
ElseIf LSC = 0 Or Limit = 0 Then
InStrAll = Array()
Exit Function
End If

If Limit < 1 Or Limit > 1000 Then ReDim Result(0 To 15) _
Else ReDim Result(0 To Limit - 1)

Dim Stride As Long: If Overlaps Then Stride = 1 Else Stride = LSM
Do
Start = InStr(Start, StringCheck, StringMatch, Compare)
If Start = 0 Then Exit Do

If RCount > UBound(Result) Then ReDim Preserve Result(0 To RCount * 2)
Result(RCount) = Start
RCount = RCount + 1

If Limit <> 1 Then Limit = Limit - 1 Else Exit Do
Start = Start + Stride
Loop

If RCount = 0 Then
InStrAll = Array()
Else
ReDim Preserve Result(0 To RCount - 1)
InStrAll = Result
End If
End Function

Here's the test harness:

Declare Function timeGetTime Lib "WinMM" () As Long
Declare Function timeBeginPeriod Lib "WinMM" (ByVal p As Long) As Long
Declare Function timeEndPeriod Lib "WinMM" (ByVal p As Long) As Long

Function StringXP(ByVal Number As Long, ByVal What As String) As String
StringXP = Space$(Number * Len(What))
Mid$(StringXP, 1) = What
Mid$(StringXP, Len(What) + 1) = StringXP
End Function

Sub InStrTest()
Dim sc As String: sc = StringXP(1000, "Supercalifragilisticexpialidocious")
Dim sm As String: sm = "SuperSoaker"
Mid$(sc, Len(sc) - 100) = "SupersoaKeR"

Const Compare = vbTextCompare

timeBeginPeriod 1

Dim t0 As Long: t0 = timeGetTime
Dim r0 As Variant: r0 = InStrAllEx(sc, sm, , , , Compare)
t0 = timeGetTime - t0

Debug.Print UBound(r0) - LBound(r0) + 1; "matches in"; t0;

Dim t1 As Long: t1 = timeGetTime
Dim r1 As Variant: r1 = InStrAll(sc, sm, , , , Compare)
t1 = timeGetTime - t1

timeEndPeriod 1

Debug.Print t1

Debug.Assert LBound(r0) = LBound(r1) And UBound(r0) = UBound(r1)
Dim i As Long: For i = LBound(r0) To UBound(r0)
Debug.Assert r0(i) = r1(i)
Next
End Sub

--
Joe Foster <mailto:jlfoster%40znet.com> On the cans? <http://www.xenu.net/>
WARNING: I cannot be held responsible for the above They're coming to
because my cats have apparently learned to type. take me away, ha ha!