an array in a loop for search for key words

[OTWarrior via OfficeKB.com]

I am needing a find loop to search for specfic words, and to copy the word
next to them
eg:

First Name: John Surname: Smith
DOB: 01/01/1952

I would need to search for First Name, Surname and DOB, but copy the "John",
"Smith" and "01/01/1952"

is it possible to do a loop that would search for the next value in an array?
eg:
Array1 = ("First Name", "Surname", "DOB")

For Array1 < ubound(Array1)
select text until (array1+1)
next array1

(i know the above code would not work at all, but hopefully you can see what
I am doing)

 

[Greg Maxey]

As for the Array part. I am not sure I understand what you are really trying
to do. Do you have a document full of names like this that you want to
process? Do you have a particular list of names as a set of the larger
document of listed names that you want to process or do you want to process
all of the names?

If you want to process all names then you don't need an array at all.

First find each entry in the form "First Name*DOB", then manipulate the
found range and strip out relevant parts of the data:

Sub ScratchMacro()
Dim oRng As Word.Range
Dim pStr1 As String, pStr2 As String, pStr3 As String, pStrFinal As String
Dim i As Long
Dim j As Long, k As Long
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "First Name*DOB"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindStop
While .Execute
oRng.MoveEnd wdCharacter, 12
i = InStr(oRng.Text, "Surname")
pStr1 = Mid(oRng.Text, 13, i - 14)
j = InStrRev(oRng.Text, "Surname") + 8
k = InStr(oRng.Text, "DOB")
pStr2 = Mid(oRng.Text, j, k - j)
pStr3 = Right(oRng.Text, 11)
pStrFinal = pStr1 + pStr2 + pStr3
MsgBox pStrFinal
oRng.Collapse wdCollapseEnd
Wend
End With
End Sub

Note, the various hard numbers are based on the spacing you have in your
example. The results will look like a dog's breakfast if your spacing
changes.

 

[OTWarrior via OfficeKB.com]

The document has alot of information relating to the one person, and I just
want to "pull" that information out. I will give your code a try as it looks
like a step in the right direction
Thank you

 

[Tony Strazzeri]

Hi Greg,

Below is another alternative using the find and extend methods.
The advantage of OTWarriors approach is that he is using ranges which
are much faster than using the selection method but I think my
approach is perhaps easier to follow and you can always change it to
use Ranges and manipulate the range start and end instead of
manipulating the selection range.


Hope this helps,

Cheers
TonyS.

 

[Tony Strazzeri]

Hi Greg,

Below is another alternative using the find and extend methods.
The advantage of OTWarriors approach is that he is using ranges which
are much faster than using the selection method but I think my
approach is perhaps easier to follow and you can always change it to
use Ranges and manipulate the range start and end instead of
manipulating the selection range.

Hope this helps,

Cheers
TonyS.

Sub Macro6()
Dim Firstname As String
Dim Surname As String
Dim strResult As String

Do Until Not GetData("First Name:", "Surname:", strResult)
Firstname = strResult

If GetData("Surname:", vbVerticalTab, strResult) Then
Surname = strResult
Else
Exit Do
'==============
End If

'Here, do whatever you need to do with this record
Loop
End Sub

Function GetData(ByVal startMark, ByVal endMark, ByRef strData) As
Boolean
Selection.Find.ClearFormatting
With Selection.Find
.Text = startMark
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

If Selection.Find.Execute Then
Selection.Collapse wdCollapseEnd

Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = endMark
.Forward = True
.Wrap = wdFindStop
End With
Selection.Find.Execute

Selection.End = Selection.End - Len(endMark)

'In your data there is a hardSpace character after the
' first name and before the "Surname:" label
'this deals with it.
strData = CleanString(Selection.Text)
strData = Trim(strData)

Selection.ExtendMode = False
Selection.Collapse wdCollapseEnd

GetData = True
Else
GetData = False
End If
End Function

 

[Greg Maxey]

Tony,

Did you confuse me with the original poster? OTWarrior didn't seem to have
an approach just a question ;-).

I think your code is interesting as I have never used an argument passed to
a function as a method of getting additional information back from the
function like your strResult and srtData.

One reason my code may appear a more convoluted is because the OP also
wanted to include the DOB in the result. Yours stops at the surname.

Cheers.

 

[Tony Strazzeri]

Tony,

Did you confuse me with the original poster? OTWarrior didn't seem to have
an approach just a question ;-).

I think your code is interesting as I have never used an argument passed to
a function as a method of getting additional information back from the
function like your strResult and srtData.

One reason my code may appear a more convoluted is because the OP also
wanted to include the DOB in the result. Yours stops at the surname.

Cheers.

Greg, My Apologies. I did confuse you with the original poster. I'm
pleased you found my approach interesting.

One of the reasons I like to program discrete functions like in my
example is that it lends itself to be extended easily.

I also missed the mention of returning an array with the values but
that is not too hard either.

Greg, I'm not meaning to teach my grandmother to suck eggs so ignore
the following. I'm putting this here as an intellectual exercise for
myself and maybe for the benefit of any less experienced programmers

If we know the number of records we can simply dimension a three
dimensional array with the required number of rows.

If we don't, we can count the number of paragraphs (which is what I
have done in this case) assuming that the structure is consistent and
each para equals one record. We could Redim the array with the
Preserve keyword but that is a nuisance with multicolumn arrays.
Another technique I sometimes use when I don't know the number of
items is to put the data into a Collection variable. If anyone is
interested I can post how I would do it that way.

Anyway here is an updated version of the code.

Hope people find it interesting.

Cheers
TonyS.


Sub GetDataOutOfParas()
Dim Firstname As String
Dim Surname As String
Dim strResult As String
Dim strDOB As String
Dim ResultAy() As String
Dim NumRec As String

'This technique is not strictly necessary but I have got into the
'the habit of where possible avoiding "Magic numbers". I'm
defining
'these to refer to the array columns to make the code easier to
read.
'I sometimes define an Enumerated type to define column names so I
can use them
'throughout my code. This is really useful when manipulating the
same data
'between arrays and multicolumn listboxes.
Const NameColumn = 0
Const SurnameColumn = 1
Const DOBColumn = 2 'make it the last coulmn


'We want to return the results into an array.
'If we know how many rows/records there are its easy.
'If we don't but the data is in a "regular" format and we can
assume
'that one paragraph =1 record then
'lets assume tat is the case.
'In which case
NumRec = ActiveDocument.Paragraphs.Count
ReDim ResultAy(NumRec - 1, DOBColumn) 'since the array starts at
zero

'Don't really need a counter if we know the number of records
'But if we don't know the number then its easier to change
'the code if it can already deal with it
NumRec = 0

selection.HomeKey wdStory
Do Until Not GetData("First Name:", "Surname:", strResult)
Firstname = strResult

'vbVerticalTab is the newline/soft return Character.
If GetData("Surname:", vbVerticalTab, strResult) Then
Surname = strResult
End If

'vbcr
If GetData("DOB:", vbCr, strResult) Then
strDOB = strResult
Else
Exit Do
'==============
End If

ResultAy(NumRec, NameColumn) = Firstname
ResultAy(NumRec, SurnameColumn) = Surname
ResultAy(NumRec, DOBColumn) = strDOB
NumRec = NumRec + 1
'Here, do whatever you need to do with this record
Loop
End Sub

Function GetData(ByVal startMark, ByVal endMark, ByRef strData) As
Boolean
selection.Find.ClearFormatting
With selection.Find
.Text = startMark
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

If selection.Find.Execute Then
selection.Collapse wdCollapseEnd

selection.Extend
selection.Find.ClearFormatting
With selection.Find
.Text = endMark
.Forward = True
.Wrap = wdFindStop
End With
selection.Find.Execute

selection.End = selection.End - Len(endMark)

'In your data there is a hardSpace character after the
' first name and before the "Surname:" label
'this deals with it.
strData = CleanString(selection.Text)
strData = Trim(strData)

selection.ExtendMode = False
selection.Collapse wdCollapseEnd

GetData = True
Else
GetData = False
End If
End Function

 

[Greg Maxey]

Tony,

Regardless your intentions, I have still been schooled. Thanks for posting.

You mention a "three dimensional" array. It appears that you only use two
dimesions (i.e., rows and columns). I have had no formal training and have
always assumed that for example
Dim myArray(4, 2) As String was creating a two dimensional array. In fact,
I have never used what I would consider a three dimensional array e.g., Dim
myArray(3, 2, 2). I would think that would be for storing data on things
like a point in space.

Please school me again if I am wrong.

Thanks

 

[Tony Strazzeri]

Hi Greg,

Nice chatting with you. I haven't been very active on these NG for a
while due to illness and am just connecting again. Its good to
actually engage in a conversation instead of just posting snippets.

You mention a "three dimensional" array. It appears that you only use two
dimesions (i.e., rows and columns). I have had no formal training and have
always assumed that for example
Dim myArray(4, 2) As String was creating a two dimensional array. In fact,

You are quite correct about the dimensioning. It is a two dimension
array that I was using. I mixed up the number of dimensions with the
number of elements/columns. The second dimension has three elements.

I have never used what I would consider a three dimensional array e.g., Dim
myArray(3, 2, 2). I would think that would be for storing data on things
like a point in space.

I don't think I have either. Now that it is mentioned, I might, at
some stage be tempted to try useing it to solve some problem. <vbg>.

As for schooling... I see this as just putting back a little of what I
get from these NGs. Over the years I have been helped numerous times
by being able to find on these NGs a solution or approach to a problem
I am working on. It is especially helpful when the solution comes
with an explanation or a little more detail on how it works and why.
You know what I mean. Besides, I often look here to find my own posts
because I have forgotten exactly how I solved a particular problem but
I remember that I had a post on it.

Cheers
TonyS.

 

[Greg Maxey]

Tony,

Yes nice chatting with you. I haven't been very active myselft since last
May. Like you I have learned plenty from these groups. While the outcome
of my effort may sometimes be crude and inefficient, I really enjoy the
mental exericise of finding a VBA solution to posters questions.

One of my favorite macros is:

Sub Cylce
Do
Learn
Teach
Loop
End Sub