Solved: search for two words in a sentance, and copy the words inbetween

[OTWarrior]

Say I have the sentance:

The cat sat on the mat

how would i search for
"The cat" & "the mat"
and copy the text inbetween (in this case: "sat on")

I know that to search for one word could be:
With Selection.Find
.Text = "name"
End With

but I am a bit lost from there

[Oorang]

Try this:
Option Explicit
Public Sub TestGetWordsInBetween()
MsgBox GetWordsInBetween("The cat sat on the mat", "cat", "mat", vbTextCompare)
End Sub

Public Function GetWordsInBetween(sentence As String, word1 As String, word2 As String, compare As VbCompareMethod)
Const lngStart_c As Long = 1
Const lngNotFound_c As Long = 0
Dim lngPos1 As Long
Dim lngPos2 As Long
lngPos1 = VBA.InStr(lngStart_c, sentence, word1, compare)
If lngPos1 = lngNotFound_c Then
Exit Function
End If
lngPos2 = VBA.InStr(lngPos1, sentence, word2, compare)
If lngPos2 = lngNotFound_c Then
Exit Function
End If
GetWordsInBetween = VBA.Mid$(sentence, lngPos1 + VBA.Len(word1), lngPos2 - lngPos1 - VBA.Len(lngPos2) - lngStart_c)
End Function

[fumei]

Aaarrrggghh. I hate scrolling. Aaarrrrgggggh.

In any case....cute. However - and BTW, this question is cross-posted elsewhere.... - I am assuming that OTWarrior has use for this within a document. Further, I will assume that the two string phrases may want to be input variables. As did Oorang.

The difference here is that the sentence is derived. In Oorang's example, the full sentence string is given. Although, that of course could be adjusted. However, there is no actual real-world interaction with a document in his code, nor does it do any looping...again, an assumption on my part.

That is, one would want to find ALL instances of text between "The cat".......and......"the mat"

For example:

The cat sat on the mat.

The cat purred its way across the mat.


The following code would display:

sat on

purred its way across Sub HereKitty(sText1 As String, sText2 As String)
Dim r As Range
Dim j As Long
Dim k As Long

Set r = ActiveDocument.Range
With r.Find
.ClearFormatting
Do While .Execute(Findtext:=sText1, _
Forward:=True) = True
j = r.End
r.Expand unit:=wdSentence
With r.Find
If .Execute(Findtext:=sText2, _
Forward:=True) = True Then
k = r.Start
MsgBox ActiveDocument.Range(Start:=j, _
End:=k).Text
End If
End With
r.Collapse Direction:=wdCollapseEnd
Loop
End With
End Sub

Sub TryFindKitty()
Call HereKitty("The cat", "the mat")
End SubNote that the HereKitty Sub derives the full sentence string. Oorang's code must be given the full sentence string.

GetWordsInBetween("The cat sat on the mat", _
"cat", "mat", vbTextCompare)

vs

HereKitty("The cat", "the mat")

Technically, it should be:

GetWordsInBetween("The cat sat on the mat", _
"cat", "the mat", vbTextCompare)

as the OP asked for the text between "The cat" and "the mat". As given the result would be "sat on the", rather than "sat on", which was requested.

[lucas]

Functional and entertaining....doesn't get any better.:bow:

[fumei]

Oh, and if you want to do better error trapping.....Sub HereKitty(sText1 As String, sText2 As String)
Const NoSecondString As String = _
"ummm...sorry but second string was not found."
Dim j As Long
Dim k As Long
Dim r As Range
Dim bolYes As Boolean
Set r = ActiveDocument.Range
With r.Find
.ClearFormatting
Do While .Execute(Findtext:=sText1, _
Forward:=True) = True
bolYes = True
j = r.End
r.Expand unit:=wdSentence
With r.Find
If .Execute(Findtext:=sText2, _
Forward:=True) = True Then
k = r.Start
MsgBox ActiveDocument.Range(Start:=j, _
End:=k).Text
Else
MsgBox NoSecondString
End If
End With
r.Collapse Direction:=wdCollapseEnd
Loop
End With
If bolYes = False Then
MsgBox "First search phrase not found."
End If
End SubIf the first string ("The cat") is not found at all, you get the message:

"First search phrase not found."

If "The cat" is found, but "the mat" is NOT, then you get:

"ummm...sorry but second string was not found."

[Oorang]

lol Well no one said we were delivering finished products ;)... Give this a try :)
Option Explicit
Private Type Segment
Start As Long
End As Long
End Type
Public Sub TestHighlightWordsBetween()
Const lngCancelled_c As Long = 0
Dim strWord1 As String
Dim strWord2 As String
strWord1 = VBA.InputBox("Enter first word:", "TestHighlightWordsBetween", "cat")
If VBA.LenB(strWord1) = lngCancelled_c Then
Exit Sub
End If
strWord2 = VBA.InputBox("Enter first word:", "TestHighlightWordsBetween", "mat")
If VBA.LenB(strWord2) = lngCancelled_c Then
Exit Sub
End If
HighlightWordsBetween strWord1, strWord2, vbTextCompare
VBA.MsgBox "Done", vbInformation + vbMsgBoxSetForeground
End Sub

Public Sub HighlightWordsBetween(word1 As String, word2 As String, _
compare As VbCompareMethod)
Const bytPrd_c As Long = 46
Const lngLB_c As Long = 0
Const lngOffset_c As Long = 1
Dim lngUB As Long
Dim bytDocTxt() As Byte
Dim lngStart As Long
Dim lngEnd As Long
Dim i As Long
Dim seg As Segment

bytDocTxt = VBA.StrConv(Word.ActiveDocument.Range, vbFromUnicode)
lngUB = UBound(bytDocTxt)
For i = lngLB_c To lngUB
If bytDocTxt(i) = bytPrd_c Then
seg = GetWordsInBetween( _
ActiveDocument.Range(lngStart, i + lngOffset_c).Text, _
word1, word2, compare)
seg.Start = lngStart + seg.Start
seg.End = lngStart + seg.End - lngOffset_c
If seg.End >= seg.Start Then
ActiveDocument.Range(seg.Start, seg.End).HighlightColorIndex = wdYellow
End If
Do
i = i + lngOffset_c
Loop Until bytDocTxt(i) <> vbKeySpace
lngStart = i
End If

Next
End Sub

Private Function GetWordsInBetween(sentence As String, word1 As String, _
word2 As String, compare As VbCompareMethod) As Segment
Const lngStart_c As Long = 1
Const lngNotFound_c As Long = 0
Dim lngPos1 As Long
Dim lngPos2 As Long
lngPos1 = VBA.InStr(lngStart_c, sentence, word1, compare)
If lngPos1 = lngNotFound_c Then
Exit Function
End If
lngPos2 = VBA.InStr(lngPos1, sentence, word2, compare)
If lngPos2 = lngNotFound_c Then
Exit Function
End If
GetWordsInBetween.Start = lngPos1 + VBA.Len(word1)
GetWordsInBetween.End = lngPos2 - lngStart_c
End Function

[TonyJollans]

Goodness! What a lot of code! Won't this do it?

Set CatRange = ActiveDocument.Range.Duplicate
While CatRange.Find.Execute(FindText:="(the cat)(*)(the mat)", _
ReplaceWith:="\2", _
MatchWildcards:=True, _
Replace:=wdReplaceOne)
MsgBox CatRange.Text
ActiveDocument.Undo
CatRange.Collapse Direction:=wdCollapseEnd
Wend

[TonyJollans]

I don't like the formatting of the continued lines there - sorry, I didn't do it like that!

[Oorang]

Aaarrrggghh. I hate scrolling. Aaarrrrgggggh.


I don't like the formatting of the continued lines there - sorry, I didn't do it like that!

:blahblah:

Whingers :razz:

[TonyJollans]

LOL!

[Oorang]

For the record, I dislike continuation characters. They make debugging a real chore, because if you do anything to change a line that uses them, it resets the project. But I decided I would have a heart and try to spare poor fumei the agony of have to click and move his wrist to the right.:sad2: The horror of it all. :rolleyes: Really I would have thought we would advanced as a civilization beyond the need for such rigorous physical excercise just to operate a computer. Well we must not lose hope.

:grinhalo:

[TonyJollans]

It's a short term problem - wide screens are being forced upon us whether we like it or not.

Now this really is a whinge :) - I've been looking at laptops and if I want one with enough depth of screen to actually see something of a document below the ribbon I need a laptop wide enough for two laps (and two aircraft seats). Office 2007 doesn't give us flexibility, modern hardware doesn't give us flexibility but the two don't sit well together. Grrrr...

[Oorang]

Actually the thing that really gripes me about the new GUI is what a pain in the neck they made it to modify it progamatically.

[TonyJollans]

Look on the bright side - you get to learn xml :D

[OTWarrior]

Wow, Loads of replies, thank you all for your input. :D

I am using fumei's code and it is having trouble with words when they are on the next cell in a table, or are duplicated (whoever designed the original form i need to import from was a numpty, as there is no standard formatting, so many different variables are needed to do this :(

[lucas]

Not able to duplicate your problem....advise you post an example instead of me posting an example......see attached.

[OTWarrior]

oops...thought I included it :(

here it is


One of the areas it fails is "First Name: " to "Address: " (guessing as there is more than one instance of this word), and also "D.O.B. " to "I.D./CUST No:" (it says it is unable to find the second string)

[fumei]

Ummmmm, you really should mention full details when you ask things. You never mentioned tables, and certainly never mentioned that the two text chunks could be in different cells.

[OTWarrior]

I know, but I just wanted the basics so I could work out the rest.
However, I have actually found a way around my problem now

Public Sub Import()
Set CurrentDoc = Word.Application.Documents(1)
With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
Exit Sub
Else
Set BrowseFile = Word.Application.Documents.Open(WordBasic.FileNameInfo$(.Name, 1))
End If

CurrentDoc.FormFields("SUDOB").Result = (Val(Replace((BrowseFile.Tables(2).Cell(5, 2)), "D.O.B. ", "")))

I still need to figure out how to separate the address from the postcode (probably a combination of the 2 function) but this seems to do the trick.

Thank you all for your help :)

[fumei]

Huh???? I got totally lost there from what was the subject of the thread.

But as you seem happy with what is happening, I guess this is good.

[OTWarrior]

I thought the way around my original problem of importing data would have to be text-based (as in find the words between 2 other words), but have just realised that is not the best way for my purposes.

Your code works perfectly on a normal non tabled document, but I realised what i wanted to achieve was more complicated.
sorry for the confusion.