find for "OR" terms (code)

[TheAntiGates]

This is so you can in Word find, e.g., either Co. or company. Once you start using this you'll be hooked like I am - there are a million times it has paid off here. How about find for Bill or Billy or William?

My VBA skills are weakest with Word, so I'll be grateful if true experts will proceed to lock and load at it. There's some narrative along those lines in the comments in the code.

I have removed tons of whitespace below to shorten wide lines, which looks severe as I preview this. I have put in needless line continuation underscores for this too. It was fine in the VBA window (though my tabsize is 2)

[VBA]'This is a nonwrapping FORWARD search for "OR" arguments, comma-separated.
'It IGNORES current selection (except to change it when the search succeeds).
'Notice that it uses the static variable sResp$, defined atop this module
'Dim sResp$
'Usage e.g.:
'Type(without the quotes)"a,e,i,o,u" in InputBox & it goes to next vowel
'Also beware that while debugging, CODE WINDOW is operated on, not
'the "active document"? - I'd sure love to know how to get around that
Sub CompoundFind() 'you're nuts not to keyboard accel. these two...
CompoundFindCommonCode (True)
End Sub
Sub CompoundFindNext()
CompoundFindCommonCode (False)
End Sub
Sub CompoundFindCommonCode(bPrompt As Boolean)
Dim iInitSelStart&, iInitSelEnd&, iCommaPos&, _
iSavPos&, iTrialPos&, iNewPos&, iNewPosLen&
Dim sstr$, bFound As Boolean, bLoopForBkSlash As Boolean
If bPrompt Then _
sResp$=InputBox$("Type multiple ' Or ' Find items, comma separated " _
& Chr(10) & "( Use \, for actual comma) ", "MultiFind", sResp$)
If sResp$ = "" Then Exit Sub
iInitSelStart=Selection.Start: iInitSelEnd=Selection.End 'for ensuing Finds
iNewPos = iInitSelStart 'our target - where we will go when done
iNewPosLen = iInitSelEnd - iInitSelStart + 1
iCommaPos = 1: iSavPos = 1: bFound = False
While iCommaPos > 0 'always do at least one Find
'aha! The next line is the key to working properly.
'Remove it, and you get bad results in Word97. It would be great
'if someone could explain what happens when next line is commented
Selection.Start = iInitSelStart + 1: Selection.End = iInitSelStart + 1
'this or next Instr will decide the Wending
iCommaPos=InStr(iSavPos,sResp$,",")
If iSavPos<=Len(sResp$) Then sstr$=Mid$(sResp$,iSavPos)'provisional
If iCommaPos>0 Then 'to restate sStr$(if iCommaPos reveals DELIMITING comma)
If iCommaPos=1 Then bLoopForBkSlash=False Else bLoopForBkSlash=True
'GRR! No exit while. Can't "while Mid$"; iCommaPos may be 1
While bLoopForBkSlash
If Not Mid$(sResp$,iCommaPos-1,1)="\" Then bLoopForBkSlash=False
If bLoopForBkSlash Then 'i.e., the Mid$ found it
sResp$=Left$(sResp$,iCommaPos-2)+Mid$(sResp$,iCommaPos)
sstr$=Mid$(sResp$,iSavPos) 'again provisionally in case no commas
iCommaPos=InStr(iCommaPos,sResp$, ",") 'not (iCommaPos+1,
If iCommaPos = 0 Then bLoopForBkSlash = False
End If
Wend
If iCommaPos>0 Then sstr$=Mid$(sResp$,iSavPos,iCommaPos-iSavPos)
iSavPos = iCommaPos + 1
End If
If sstr$ <> "" Then
With Selection.Find
.Forward = True: .Wrap = wdFindStop: .Execute FindText:=sstr$
End With
End If
' MsgBox "<" + sStr$ + "> " + Str$(Selection.Find.Found)
'Stop
If Selection.Find.Found Then
bFound = True: iTrialPos = Selection.Start
If iNewPos = iInitSelStart Then 'trial's our very first hit - save it
iNewPos = iTrialPos: iNewPosLen = Len(sstr$)
Else 'else iNewPos DID have prior value; update if sooner in file
If iTrialPos<iNewPos Then iNewPos=iTrialPos: iNewPosLen=Len(sstr$)
End If
End If
Selection.Start = iInitSelStart: Selection.End = iInitSelEnd
Wend
If bFound Then Selection.Start=iNewPos: _
Selection.End=iNewPos+iNewPosLen _
Else MsgBox "Solly, no, Cholly"
End Sub[/VBA]

[Anne Troy]

Did you need help with it? If not, perhaps you want to create a kb entry, dude. www.vbaexpress.com/kb You'll need to log in the first time you use it (just like the forum), but it's the same name/pwd as the forum.

[Howard Kaikow]

The code below:

1. Eliminates the While exiting issue.
2. Eliminates the bLoopForBkSlash variable.
3. Explicitly types, but not change the names of variables.
4. Eliminates unnecessary object references.
5. Adds other efficiences.

Note that this code runs in the document, even when running the code line by line.

I've not tried the code in Word 97.

.Start = iInitSelStart + 1

Moves the start of the selection, apparently causing the code to skip the first character in the selection.

Is that so, I've not analyzed it carefully.

Was that intended?


[vba]
Option Explicit
' Modified by Howard Kaikow (kaikow@standards.com) on 28 February 2005

'This is a nonwrapping FORWARD search for "OR" arguments, comma-separated.
'It IGNORES current selection (except to change it when the search succeeds).

'Usage e.g.:
'Type(without the quotes)"a,e,i,o,u" in InputBox & it goes to next vowel

Private sResp As String

Sub CompoundFind()
CompoundFindCommonCode (True)
End Sub
Sub CompoundFindNext()
CompoundFindCommonCode (False)
End Sub
Sub CompoundFindCommonCode(bPrompt As Boolean)
Dim bFound As Boolean
Dim iCommaPos As Long
Dim iInitSelEnd As Long
Dim iInitSelStart As Long
Dim iNewPos As Long
Dim iNewPosLen As Long
Dim iSavPos As Long
Dim iTrialPos As Long
Dim sstr As String

If bPrompt Then
sResp = InputBox$("Type multiple ' Or ' Find items, comma separated " _
& vbCr & "( Use \, for actual comma) ", "MultiFind", sResp)
End If
If Len(sResp) = 0 Then
Exit Sub
End If
With Selection
iInitSelStart = .Start
iInitSelEnd = .End 'for ensuing Finds
iNewPos = iInitSelStart 'our target - where we will go when done
iNewPosLen = iInitSelEnd - iInitSelStart + 1
iCommaPos = 1
iSavPos = 1
bFound = False
While iCommaPos > 0 'always do at least one Find
'aha! The next line is the key to working properly.
'Remove it, and you get bad results in Word97. It would be great
'if someone could explain what happens when next line is commented
.Start = iInitSelStart + 1
.End = iInitSelStart + 1
'this or next Instr will decide the Wending
iCommaPos = InStr(iSavPos, sResp, ",")
If iSavPos <= Len(sResp) Then
sstr = Mid$(sResp, iSavPos) 'provisional
End If
If iCommaPos > 0 Then 'to restate sstr(if iCommaPos reveals DELIMITING comma)
If iCommaPos <> 1 Then
Do
If Not Mid$(sResp, iCommaPos - 1, 1) = "\" Then
Exit Do
End If
sResp = Left$(sResp, iCommaPos - 2) + Mid$(sResp, iCommaPos)
sstr = Mid$(sResp, iSavPos) 'again provisionally in case no commas
iCommaPos = InStr(iCommaPos, sResp, ",") 'not (iCommaPos+1,
If iCommaPos = 0 Then
Exit Do
End If
Loop
End If
If iCommaPos > 0 Then
sstr = Mid$(sResp, iSavPos, iCommaPos - iSavPos)
End If
iSavPos = iCommaPos + 1
End If
If Len(sstr) <> 0 Then
With .Find
.Forward = True
.Wrap = wdFindStop
.Execute FindText:=sstr
End With
End If

If .Find.Found Then
bFound = True
iTrialPos = .Start
If iNewPos = iInitSelStart Then 'trial's our very first hit - save it
iNewPos = iTrialPos
iNewPosLen = Len(sstr)
Else 'else iNewPos DID have prior value; update if sooner in file
If iTrialPos < iNewPos Then
iNewPos = iTrialPos
iNewPosLen = Len(sstr)
End If
End If
End If
.Start = iInitSelStart
.End = iInitSelEnd
Wend
If bFound Then
.Start = iNewPos
.End = iNewPos + iNewPosLen
Else
MsgBox "Solly, no, Cholly"
End If
End With
End Sub
[/vba]

[TheAntiGates]

Man, concentrating on this is tough while Buffy is on TV (actually BuffyBot in this arc)
Thank you for the evaluation. I incorporated almost all your changes. Dohhhh - of course, you can't exit while but you can exit Do - thanks.

Selection.Start = iInitSelStart + 1
is a strange animal, having to do with how .Find.Execute operates. I would appreciate help testing this on other word versions.

Make your document consist entirely of simply the 4 bytes aeae and put the cursor at start of the doc and run CompoundFind as is, answering a,e to the prompt. It finds everything, one by one. But use Selection.Start=iInitSelStart (no +1 ), and it only finds the letter e. Quite bizarre.

If the +1 is instead removed from the line near the end of the while loop, then the last find occurrence fails. Brutal.

AAR as I'm resigned to its necessity (and I've hoisted it for the next update).

Not for war, but I added a thread "CompoundFind style" to explain "formatting differences."

Second version. I'm still open to enhancements/cleanups before KBing it.

'This is a nonwrapping FORWARD search for "OR" arguments, comma-separated.
'It changes current selection when the search succeeds; otherwise
'selection only affects the scope of CompoundFind (not CompoundFindNext)
'Notice that it uses the static variable sResp$, defined atop this module
'Dim sResp$
'Usage examples:
'Type(without the quotes)"a,e,i,o,u" in InputBox & it goes to next vowel
'Type(without the quotes) "Bill,Billy,William" in InputBox & watch it work!
Sub CompoundFind() 'you're nuts not to keyboard accel. these two...
	CompoundFindCommonCode (True) 
End Sub 
Sub CompoundFindNext() 
	CompoundFindCommonCode (False) 
End Sub 
Sub CompoundFindCommonCode(bPrompt As Boolean)
Dim iInitSelStart&,iInitSelEnd&,iCommaPos&,iSavPos&,iTrialPos&,iNewPos&,iNewPosLen&
Dim sStr$, bFound As Boolean
'There's an underscore _ at end of next line in case you can't see it
If bPrompt Then sResp=InputBox$("Type multiple ' Or ' Find items,comma separated " _
& vbCr & "( Use \, for actual comma) ", "MultiFind", sResp)
If sResp = "" Then Exit Sub
iInitSelStart = Selection.Start: iInitSelEnd = Selection.End	'for ensuing Finds
Selection.Start = iInitSelStart + 1		 'looks queer, but required in W97
iNewPos = iInitSelStart			'our target - where we will go when done
iNewPosLen = iInitSelEnd - iInitSelStart + 1
iCommaPos = 1: iSavPos = 1: bFound = False
While iCommaPos > 0				 'always do at least one Find
	iCommaPos=InStr(iSavPos,sResp,",") 'this or next Instr'll decide the Wending
	If iSavPos <= Len(sResp) Then sStr = Mid$(sResp, iSavPos) 'provisional
	If iCommaPos>0 Then 'to restate sStr(if iCommaPos reveals DELIMITING comma)
	 If iCommaPos <> 1 Then
	 Do
		If Not Mid$(sResp, iCommaPos - 1, 1) = "\" Then Exit Do
		sResp = Left$(sResp, iCommaPos - 2) + Mid$(sResp, iCommaPos)
		sStr = Mid$(sResp, iSavPos) 'again provisionally in case no commas
		iCommaPos = InStr(iCommaPos, sResp, ",")	 'not (iCommaPos+1,
		If iCommaPos = 0 Then Exit Do
	 Loop
	 End If
	 If iCommaPos > 0 Then sStr = Mid$(sResp, iSavPos, iCommaPos - iSavPos)
	 iSavPos = iCommaPos + 1
	End If
	If sStr <> "" Then
	 With Selection.Find
		.Forward = True: .Wrap = wdFindStop: .Execute FindText:=sStr
	 End With
	End If
	If Selection.Find.Found Then
	 bFound = True: iTrialPos = Selection.Start
	 If iNewPos = iInitSelStart Then 'trial's our very first hit - save it
		iNewPos = iTrialPos: iNewPosLen = Len(sStr)
	 Else	 'else iNewPos DID have prior value; update if sooner in file
		If iTrialPos<iNewPos Then iNewPos=iTrialPos: iNewPosLen=Len(sStr)
	 End If
	End If
	Selection.Start = iInitSelStart + 1: Selection.End = iInitSelEnd
Wend
If bFound Then Selection.Start=iNewPos: Selection.End=iNewPos+iNewPosLen _
Else MsgBox "Solly, no, Cholly"
End Sub

Forgive the indenting. I don't have control over the tag (do I?!). It looks fantastic on MY PC