Is it While or For or none of the above

[Joanne]

Hello, in the following code I am search for a string which begins with the
number "1" and then looks for three or four mor numbers plus an "'". Then it
adds the found string to an array. What I would like the code to do is get
all of the instances where the first number is "1", paste them into a certain
cell in a table, then get all the instances where the first number is "2" and
paste them into another specific cell in a table, etc. etc. I'm not sure how
to increment the "iAddMan" variable, which is the number "1" or the number
"2" etc. at the start of the string, within the loop I've currently got.
Maybe my approach is wrong.

Thanks as always for any help that you can provide.


iAddNum = 1
iCount = 0
strTxt = GetPrimes(iAddNum)
strTxt = iAddNum & "[0-9]{3,4}'"
Set Doc = ActiveDocument
Set rng = Doc.Range
Set tblTab = Doc.Tables(1)
blnNumFound = True
'Set NewElemDoc = GetIndex

Doc.Activate
With rng.Find
..ClearFormatting
..Text = strTxt
..Wrap = wdFindStop
..MatchWildcards = True
..Forward = True
Do While .Execute(Replace:=wdReplaceNone)
.Execute Replace = wdReplaceNone
Selection.SelectCell
pos = InStr(Selection, iAddNum)
If pos = 1 And Selection.Cells(1).ColumnIndex = 1 Then
ReDim Preserve strAray(iCount)
strAray(iCount) = Selection
iCount = iCount + 1
End If

rng.Collapse wdCollapseEnd
Selection.Collapse wdCollapseEnd
Loop

..ClearFormatting
..Forward = True
..Text = ""
..Wrap = wdFindContinue

End With

 

[Greg]

Joane,

Perhaps something like this will do. The result is posted in a
5Colc2Row table.

Sub Test()
Dim oRng As Word.Range
Dim oTbl As Table
Dim strFindTxt As String
Dim i As Integer
Dim tempList() As String
Dim strFoundText As String

Set oTbl = ActiveDocument.Tables(1)

i = 1

For i = 1 To 9
strFindTxt = i & "[0-9]{3,4}'"
Set oRng = ActiveDocument.Range
ReDim tempList(0)
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strFindTxt
.Wrap = wdFindStop
.MatchWildcards = True
.Forward = True
While .Execute
strFoundText = oRng.Text
tempList(UBound(tempList)) = strFoundText
'Prepare for next entry
ReDim Preserve tempList(UBound(tempList) + 1)
Wend
End With
Select Case i
Case Is = 1
oTbl.Cell(1, i).Range.Text = Join(tempList, " ")
Case Is = 2
oTbl.Cell(1, i).Range.Text = Join(tempList, " ")
Case Is = 3
oTbl.Cell(1, i).Range.Text = Join(tempList, " ")
Case Is = 4
oTbl.Cell(1, i).Range.Text = Join(tempList, " ")
Case Is = 5
oTbl.Cell(1, i).Range.Text = Join(tempList, " ")
Case Is = 6
oTbl.Cell(2, i - 4).Range.Text = Join(tempList, " ")
Case Is = 7
oTbl.Cell(2, i - 4).Range.Text = Join(tempList, " ")
Case Is = 8
oTbl.Cell(2, i - 4).Range.Text = Join(tempList, " ")
Case Is = 9
oTbl.Cell(2, i - 4).Range.Text = Join(tempList, " ")
Case Else
End Select
Next i
End Sub

 

[Joanne]

Thank you! That worked pefectly.