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 -
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 loopCode: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




Reply With Quote