Cant select new table in word

Hi
I've written some code that searches tables in my document for the word "category" and then extracts data from each table and stores it in an array. I then want to create a summary table to list the extrcated data. I have got as far as populating the arrays and creating the new data but I cant work out how to select the new table to populate it. No matter what I do the selection always includes the last table from the data extraction. I'm sure its my beginners VBA code but if someone can point out the simple mistake it would really help me out. The code I have is as follows -

Code:

---

count = 0
For Each Table In ActiveDocument.Tables
            Table.Select
            'With Selection.Find
            '  .Forward = True
            '  .Format = False
            '  .MatchCase = True
            '  .MatchWholeWord = False
            '  .MatchWildcards = False
            '  .MatchSoundsLike = False
            '  .MatchAllWordForms = False
            '  .Execute FindText:="Category"
            'End With
            Selection.Find.Execute Findtext:="Category"
            If Selection.Find.Execute = True Then
            count = count + 1
            ref(count) = Table.Cell(Selection.Cells(1).RowIndex - 1, 1)
            ref(count) = Left(ref(count), Len(ref(count)) - 2)
            title(count) = Table.Cell(Selection.Cells(1).RowIndex - 1, 2)
            title(count) = Left(title(count), Len(title(count)) - 2)
            If Table.Cell(Selection.Cells(1).RowIndex, 2).Shading.BackgroundPatternColor <> wdColorWhite Then
            category(count) = "Test1"
            ElseIf Table.Cell(Selection.Cells(1).RowIndex, 3).Shading.BackgroundPatternColor <> wdColorWhite Then
            category(count) = "Test2"
            Else
            category(count) = "Test3"
            End If
            End If
Next Table
Selection.Tables(1).Select
Selection.Collapse wdCollapseEnd
SendKeys "{DOWN 1}"
SendKeys vbCr   
Set mytable = Selection.Tables.Add(Range:=Selection.Range, _
    NumRows:=count + 1, NumColumns:=3)
    mytable.Range.Select
    With Selection.Tables(1)
    For intX = 2 To count + 1
            .Cell(intX, 1).Range.InsertAfter ref(intX)
            .Cell(intX, 2).Range.InsertAfter title(intX)
            .Cell(intX, 3).Range.InsertAfter category(intX)
    Next intX
    .Columns.AutoFit
    End With
End Sub

---

No matter what I've tried the code at the end always selects the new table, the inserted line between the tables and the last table from the for-next extraction loop

If I am understanding correctly, your code is creating the new table, then inserting the text in the for-next loop between the new table and the last extracted data table? If this is right, I would change my with statement to:

Code:

---

With mytable

---

and I would change

Code:

---

            .Cell(intX, 1).Range.InsertAfter ref(intX)
            .Cell(intX, 2).Range.InsertAfter title(intX)
            .Cell(intX, 3).Range.InsertAfter category(intX)

---

to

Code:

---

            .Cell(intX, 1).Range.Text = ref(intX)
            .Cell(intX, 2).Range.Text = title(intX)
            .Cell(intX, 3).Range.Text = category(intX)

---