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