loop through a table find text and copy and paste into another table

[Strongs]

I have two tables in a word document. Table one has two columns and multiple rows. Column one in table one, contains a numbering system (1.2, 1.2.1, 1.2.1.1)etc; i want to search through this table and find all instances of x.x and copy and paste the instances into table two. To make the search easier, i have set up a loop that inserts white space at the beginning and end of the numbers in column one. i have tried to set up a loop that does this, but it only finds 1 instance, pastes it into the other table and then stops.

any help would be gratefuly received.

[fumei]

It helps if you post code.

Some suggestions.

Use objects. Make each table a table object. This makes it MUCH easier to reference stuff in the tabler.

It also makes it easier to do your copying, as you can reference the contents directly - WITHOUT any actual copying and pasting.Sub YaddaYadda()
Dim aTable1 As Table
Dim aTable2 As Table
Dim aCell As Cell
Dim lngCellCol As Long
Dim lngCellRow As Long
Dim aCellText As String
Set aTable1 = ActiveDocument.Tables(2)
Set aTable2 = ActiveDocument.Tables(5)

For Each aCell In aTable1.Range.Cells
' see Note
aCellText = Left(aCell.Range.Text, _
Len(aCell.Range.Text) - 2)
If aCellText = "blah" Then
lngCellCol = aCell.ColumnIndex
lngCellRow = aCell.RowIndex
aTable2.Cell(lngCellRow, lngCellCol).Range _
.Text = aCellText
End If
Next
Set aTable1 = Nothing
Set aTable2 = Nothing
End SubNote:

To accurately use the text from a cell you need to strip off the two characters (Chr(13) + Chr(7)) that make of the end-of-cell marker.

The code makes table objects of Table(2) and Table(5). It checks each cell in the first table. If the text = "blah", then it makes the text of the cell with the SAME Row/Column location in the other table that text. I emphasize this, as it certainly does not have to be the exact same location. You can do whatever you want.

There is no copy and paste. It directly makes the other cell Range.Text = the text.

So....

Either post some code so we can possibly help you tweak it, OR give a bit more detail about what you are doing.

[fumei]

BTW: if you do a lot of work getting text from table cells, make a Function to get just that text.Function CellText(strIn As String) As String
CellText = Left(strIn, Len(strIn) - 2)
End FunctionNow you can get the text of any cell with a call to the Function.For Each aCell In aTable1.Range.Cells
aCellText = CellText(aCell.Range.Text)
If aCellText = "blah" Then

[Strongs]

BTW: if you do a lot of work getting text from table cells, make a Function to get just that text.Function CellText(strIn As String) As String
CellText = Left(strIn, Len(strIn) - 2)
End FunctionNow you can get the text of any cell with a call to the Function.For Each aCell In aTable1.Range.Cells
aCellText = CellText(aCell.Range.Text)
If aCellText = "blah" Then

[fumei]

Huh? You copied my post and did not say anything.

[Strongs]

Hi Gerry,

thank you for replying to the thread. Unfortunately, i am not a programmer, nor am i proficient in VBA, so I would be a little embarassed to post my code! however, i will try to explain what it is that i need to do.

the original document starts out as a Business Objects Report. This is exported from Business Objects as a .txt file.

the file is then opened up in Excel. The information consists of rows of text that make up a lesson plan. Each lesson plan can consist of many rows of text and each course can consist of many lesson plans (within the same .txt document).

Currently, each lesson plan is transferred to a word document for greater clarity and for the end user to add some information. This traditionally has been achieved by typing in all the information manually!

What I have done so far, is set up a VBA script that does the following: The user copies the lesson plan from the Excel worksheet, opens the word document which then pastes the lesson plan, converts it into a 4 column table with the numbering system (1.2, 1.2.3, 12.1, 1.2.2.2.1 )etc into the first column, the description into the second column and two form fields into the remaining two columns for the user to complete (the document will be protected).

this information then needs to be broken down further into another two tables: 1 table will contain all of the x.x numbers with corresponding descriptions and another will contain all of the x.x.x numbers with corresponding descriptions. Of course, the user could do this manually by copying and pasting, but this seems to defeat the object of document automation.

I thought that find, copy and paste may be the solution, but it is proving more difficult than I imagined it would be.

If you need any further information, please let me know.

Once again Gerry, thanks for you help.

sorry about the blank reply. not sure what happened there.

[fumei]

Please do not ever feel embarassed to post code. Oh I know some will say I am hard on people, but it is not true. Really. I don't bite. We ALL started with sloopy misunderstood code. heck I still write some. Be at ease.

It would make it MUCH easier if you did post code. "Talking" through/about code is poor communication. Better yet, can you post sample files?

[Strongs]

Hi Gerry,
Thanks again for getting back to me. Sorry for the delay in responding, been away for a couple of days. I have attached a zipped word doc that contains the template for the document. The code is embedded in the User Form. I will send another post with an excel file so that you can copy the numbered text from there to see the problem that I am having.

If you have any problems with unzipping the files, then let me know and i will send the code as a post.

regards,

Paul

[Strongs]

Excel file as promised.

[mdmackillop]

Oh I know some will say I am hard on people, but it is not true. Really. I don't bite.
:rotflmao:

[mdmackillop]

Hi Strongs
Can you post the code you're using and also show the desired output. I think I know what you're after, but I'm not sure of the layout and I'd rather have confirmation.

[Strongs]

Hi mdmackillop,

Thank you for responding to the post. I posted two documents yesterday, the word document in which the code resides, and an excel document with a sample of the text that is being copied and pasted into the word document. Below is the code from the document. Being a complete rookie in VBA, the code is probably very unelegant. However, it does what I want it to until it has to find the x.x range of numbers and associated text and paste into another table. Likewise with the x.x.x range of numbers.
The x.x range of numbers are to be pasted into a one column table (however, they could be pasted as seperate paragraphs if this is easier), whilst the x.x.x range of numbers are to be pasted into a two column
table (these need to be in a table).
I have tried various wildcard searches to only catch those numbers in the range above and in frustration, resorted to placing white space before and after the numbers to make it easier to search. The loop for finding the range numbers i know are wrong and that is probably where the problem arises.

The code is part of an onClick() event on the user form hence the textfield code at the beginning.

Look forward to your ideas.

Sub FormatDoc()
'
'Catch incomplete text fields
Application.ScreenUpdating = False
If TextBox1 = "" Then
MsgBox "Course No. requires a value"
TextBox1.SetFocus
TextBox1.BackColor = "65535"
Exit Sub
End If

If TextBox2 = "" Then
MsgBox "Course Name requires a value"
TextBox2.SetFocus
TextBox2.BackColor = "65535"
Exit Sub
End If

If TextBox4 = "" Then
MsgBox "Lesson Title requires a value"
TextBox4.SetFocus
TextBox4.BackColor = "65535"
Exit Sub
End If

If TextBox5 = "" Then
MsgBox "TO requires a value"
TextBox5.SetFocus
TextBox5.BackColor = "65535"
Exit Sub
End If

If TextBox8 = "" Then
MsgBox "Duration requires a value"
TextBox8.SetFocus
TextBox8.BackColor = "65535"
Exit Sub
End If

If TextBox9 = "" Then
TextBox9.SetFocus
TextBox9.BackColor = "65535"
Exit Sub
End If

If TextBox10 = "" Then
MsgBox "ISpec requires a value"
TextBox10.SetFocus
TextBox10.BackColor = "65535"
Exit Sub
End If
'
'Locate bookmarks and place textfield text
Dim rng As Range
'
Set rng = ActiveDocument.Bookmarks("CseNoMain").Range
rng.InsertAfter TextBox1
'
Set rng = ActiveDocument.Bookmarks("CseNo").Range
rng.InsertAfter TextBox1
'
Set rng = ActiveDocument.Bookmarks("CseNameMain").Range
rng.InsertAfter TextBox2
'
Set rng = ActiveDocument.Bookmarks("CseName").Range
rng.InsertAfter TextBox2
'
Set rng = ActiveDocument.Bookmarks("Module").Range
rng.InsertAfter TextBox3
'
Set rng = ActiveDocument.Bookmarks("LsnTitle").Range
rng.InsertAfter TextBox4
'
Set rng = ActiveDocument.Bookmarks("LsnTitleMain").Range
rng.InsertAfter TextBox4
'
Set rng = ActiveDocument.Bookmarks("TO").Range
rng.InsertAfter TextBox5
'
Set rng = ActiveDocument.Bookmarks("IssNo").Range
rng.InsertAfter TextBox6
'
Set rng = ActiveDocument.Bookmarks("RevDate").Range
rng.InsertAfter TextBox7
'
Set rng = ActiveDocument.Bookmarks("Duration").Range
rng.InsertAfter TextBox8
'
Set rng = ActiveDocument.Bookmarks("Venue").Range
rng.InsertAfter TextBox9
'
Set rng = ActiveDocument.Bookmarks("ISpec").Range
rng.InsertAfter TextBox10
'
Unload Me
'
'Start pasting of KLPs
'On Error GoTo CopyText
'
'Paste excel table
Selection.GoTo what:=wdGoToBookmark, Name:="PasteKLP"
Selection.PasteExcelTable False, False, True
Selection.MoveUp unit:=wdLine, Count:=1
'
'Convert excel table to text
Selection.Tables(1).Select
Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
True
Selection.Style = ActiveDocument.Styles("Normal")
'
'Convert text to table
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=4, _
NumRows:=26, AutoFitBehavior:=wdAutoFitContent
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.MoveLeft unit:=wdCharacter, Count:=1
Selection.SelectColumn
Selection.Font.Bold = wdToggle
Selection.MoveRight unit:=wdCell
Selection.MoveRight unit:=wdCell
Selection.MoveRight unit:=wdCell
Selection.FormFields.Add Range:=Selection.Range, Type:= _
wdFieldFormTextInput
Selection.PreviousField.Select
With Selection.FormFields(1)
.Name = "Text5"
.EntryMacro = ""
.ExitMacro = ""
.Enabled = True
.OwnHelp = False
.HelpText = ""
.OwnStatus = False
.StatusText = ""
With .TextInput
.EditType Type:=wdRegularText, Default:="Insert Info Here", _
Format:=""
.Width = 0
End With
End With
Selection.SelectCell
Selection.Copy
Selection.SelectColumn
Selection.Paste
Selection.MoveRight unit:=wdCell
Selection.MoveRight unit:=wdCell
Selection.SelectColumn
Selection.Paste
'
Selection.SelectRow
Selection.InsertRowsAbove 1
Selection.Rows.HeadingFormat = True
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle
With Selection.Cells
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorGray10
End With
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.MoveLeft unit:=wdCharacter, Count:=1
Selection.TypeText Text:="KLP No"
Selection.MoveRight unit:=wdCell
Selection.TypeText Text:="Key Learning Point"
Selection.MoveRight unit:=wdCell
Selection.TypeText Text:="Method and Media"
Selection.MoveRight unit:=wdCell
Selection.TypeText Text:="Instructor Notes"
Selection.Tables(1).Select
Selection.Rows.AllowBreakAcrossPages = False
Selection.MoveLeft unit:=wdCharacter, Count:=1
'
'Set table columns to required width
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(4.63)
Selection.Move unit:=wdColumn, Count:=1
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(10.48)
Selection.Move unit:=wdColumn, Count:=1
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(5.08)
Selection.Move unit:=wdColumn, Count:=1
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = CentimetersToPoints(5.89)
Selection.MoveLeft unit:=wdCharacter, Count:=1
'
'Set cell padding
Selection.Tables(1).Select
With Selection.Tables.Item(1)
.TopPadding = CentimetersToPoints(0.1)
.BottomPadding = CentimetersToPoints(0.1)
.LeftPadding = CentimetersToPoints(0.19)
.RightPadding = CentimetersToPoints(0.19)
'.WordWrap = True
'.FitText = False
End With
'
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
Selection.WholeStory
Selection.Fields.Update
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'
'Sort the text by KLP number
Selection.GoTo what:=wdGoToTable, which:=wdGoToFirst, Count:=9
Selection.SelectColumn
Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
:=wdSortFieldNumeric, SortOrder:=wdSortOrderAscending, FieldNumber2:="", _
SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:=wdSortOrderAscending _
, FieldNumber3:="", SortFieldType3:=wdSortFieldAlphanumeric, SortOrder3:= _
wdSortOrderAscending, Separator:=wdSortSeparateByCommas, SortColumn:= _
False, CaseSensitive:=False, LanguageID:=wdEnglishUK, SubFieldNumber:= _
"Paragraphs", SubFieldNumber2:="Paragraphs", SubFieldNumber3:= _
"Paragraphs"
Selection.Move unit:=wdRow, Count:=1
'
'
'
'
'
'
'Insert white space at beginning and end of cell content for search purposes
Selection.GoTo what:=wdGoToTable, which:=wdGoToFirst, Count:=9
Selection.Move unit:=wdColumn, Count:=0
Selection.Move unit:=wdRow, Count:=1

For i = 1 To ActiveDocument.Tables(9).Rows.Count
'
Selection.InsertBefore " "
Selection.MoveEndUntil Chr(13)
Selection.InsertAfter " "
Selection.Move unit:=wdRow, Count:=1
Next i
'


Selection.GoTo what:=wdGoToTable, which:=wdGoToFirst, Count:=9
Selection.Move unit:=wdColumn, Count:=0
Selection.Move unit:=wdRow, Count:=1

'find all x.x numbers and text in next column and paste into appropriate table
'having trouble with this one. Need to catch every instance of x.x, x.xx, xx.x
For j = 1 To ActiveDocument.Tables(9).Rows.Count
Selection.Find.ClearFormatting
With Selection.Find
.Text = " [0-9]@.[0-9]@ "
'.Text = "^w^#.^#^w"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

If Selection.Find.Found = True Then
Selection.MoveRight unit:=wdCharacter, Count:=2, Extend:=wdExtend
Selection.Copy
Selection.GoTo what:=wdGoToTable, Count:=2
Selection.Move unit:=wdRow, Count:=2
Selection.Rows.Add
Selection.Move unit:=wdRow, Count:=Last
Selection.PasteSpecial datatype:=wdPasteText
'Selection.Paste

Selection.GoTo what:=wdGoToTable, which:=wdGoToFirst, Count:=9
Selection.Move unit:=wdColumn, Count:=0
Selection.Move unit:=wdRow, Count:=1
Selection.Move unit:=wdRow, Count:=k
End If
Next j

'find all x.x.x numbers and text in next column and paste into appropriate table
'having trouble with this one. Need to catch every instance of x.x.x, xx.x.x, x.xx.x etc;
For k = 1 To ActiveDocument.Tables(9).Rows.Count
Selection.Find.ClearFormatting
With Selection.Find
.Text = " [0-9]@.[0-9]@.[0-9]@ "
'.Text = "^w^#.^#.^#^w"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

If Selection.Find.Found = True Then
Selection.MoveRight unit:=wdCharacter, Count:=2, Extend:=wdExtend
Selection.Copy
Selection.GoTo what:=wdGoToTable, Count:=7
Selection.Move unit:=wdColumn, Count:=0
Selection.Rows.Add
Selection.Move unit:=wdRow, Count:=Last
Selection.Paste

Selection.GoTo what:=wdGoToTable, which:=wdGoToFirst, Count:=9
Selection.Move unit:=wdColumn, Count:=0
Selection.Move unit:=wdRow, Count:=1
Selection.Move unit:=wdRow, Count:=k
End If
Next k

'If all is well, save the document
ActiveDocument.GoTo what:=wdGoToTable, which:=wdGoToFirst, Count:=1
ActiveDocument.CheckSpelling
ActiveDocument.Protect wdAllowOnlyFormFields, NoReset, ("xxxx")
'
With Dialogs(wdDialogFileSaveAs)
.Name = ActiveDocument.FullName
.Show
End With

'
MsgBox "Your ISpec is complete!"
'
'In case of error, do this
CopyText:
'
If Err <> 0 Then MsgBox "Copy ISpec text from the Excel worksheet and try again", vbOKOnly_
'
'Close the document if no selection has been made from an Excel worksheet
If Err <> 0 Then ActiveDocument.Close savechanges:=wdDoNotSaveChanges, originalformat:=wdOriginalDocumentFormat
'
Application.ScreenUpdating = True
End Sub

[fumei]

Very funny Malcolm. And there I was, trying to be nice.

[fumei]

Strongs,

1. Please use the VBA code window when posting code.

2. Use Option Explicit in your code!!! You will save yourself much work if you do. I strongly, strongly recomend you do this.

3. I can not get anything to run properly as there is a Reference missing. It appears to be a Reference to Normal. That would be your Normal.dot. I removed the Reference and have not found any serious consequences yet.

4. Name your controls!Private Sub CommandButton2_Click()

TextBox1 = ""
TextBox1.BackColor = "16777215"
TextBox2 = ""
TextBox2.BackColor = "16777215"
TextBox3 = ""
' etc.So....ummmmm, which button is #2???? OK? Start Again? Cancel? Name your controls!

5. Use objects. They make it much clearer, AND they allow shorter less repeating code. Here is the code for the same commandbutton above....named cmdStartAgain....as that is its Caption.Private Sub cmdStartAgain_Click()

Dim ctl As Control
For Each ctl In Me.Controls
If TypeOf ctl Is TextBox Then
With Me.Controls(ctl.Name)
.Value = ""
.BackColor = "16777215"
End With
End If
Next
End SubAlthough I would probably name the button "Clear", but that is only my preference. Your objective here is to clear all content of all textboxes and set a Backcolor. Although WHY you are doing the Backcolor, I have no idea. It is not like the user can change it. By using objects you can do this. The code above runs through all the controls on the userform, if it is a TextBox, it makes it "", and sets the backcolor.

I am working my way through to your actual issue.....

Oh...never mind, now I see why you set the Backcolor. You change it when you have a blank Textbox. BTW: the error trapping on the blank textboxes could be improved by naming them, building an array of them and checking if any are "". As it is, if three different textboxes are "" you are only detecting one of them.

[Strongs]

Hi Gerry,

Have I broken protocol by responding to another response? If so, then I apologise.

[fumei]

There is no protocol regarding this. Absolutely no need to apologize for anything.

[fumei]

Moving along. Actually Strongs....not bad in concept.

Although your non-use of Option Explicit drove me crazy for a while. You have all these undeclared variables (i, j, k, Last) that error out as I am using Option Explicit.

Also, you may not notice (as you wouldn't without Option Explicit) but you have other errors.

A Msgbox that terminates with vbOKOnly_ The "_" is an error. This stops the execution with Option Explicit.

The instruction line to protect the formfields has an error.
You have NoReSet. It requires a value. Without Option Explicit you should (I think) get a run-time error with this.

NoReSet:=True (or False)

I really do NOT like the use of additonal formfields that do NOT have a name. In fact...a number of your formfields do not have a name. The name is blank. This occurs when you copy and paste formfields.

The reason I mention this is that if you ever want to get information OUT of the formfields, it is very difficult without a name.

Still working on your xx.xxx. stuff. What I would like is a sample document with an example table looking the way you want it.

Lastly, If this is a serious production effort (that is, it will be used by people in a production environment) you may want to consider better error trapping of input.

I can put "akdhs hslfhsy3trw;rlhwhl345900-mki" in the Duration field. It is an acceptable value.

[Strongs]

Hi Gerry,
Thanks for the observations. Be as critical as you can because it is the only way that I can learn from this attempt. I have just invested in a couple of VBA books from Amazon in an effort to learn more.

Posted a sample file that is completed.
Thanks once again.

[mdmackillop]

Hi Strongs,
It occured to me that x.x is a valid number. You can simply loop and test for this
Sub Test()
Dim MyVal As String, i As Long
With ActiveDocument.Tables(1)
For i = 1 To .Rows.Count
MyVal = Left(.Cell(i, 1), Len(.Cell(i, 1).Range) - 2)
If IsNumeric(MyVal) Then MsgBox MyVal
Next
End With
End Sub

[fumei]

I am not following the oprdering logic. from your sample file.

2.8
3.8
2.8.1
2.8.1.1.1
2.8.2
2.81.1
2.8.1.3.1
2.8.1.3.2

Why is 3.8 after 2.8, but BEFORE 2.8.1?

Please explain, in particular:

2.8.1.1.1
2.8.2
2.81.1
2.8.1.3.1

Why is 2.8.1.1 AFTER 2.8.2?

In the .xls you supplied there is no x.xx.x - a double digit second placement. Is there?

[fumei]

Malcolm, I freely admit I am NOT an Excel person. Frankly, I never use it and so I know nothing. However, I do know something about the principles of VBA.

Question: it must be possible to determine the structure of a selection in Excel, so how is that done?

Say the person selects the first five rows out of the sample xls file the OP posted. Can you loop through that selection extracting data, by cell. There are two columns.

So for our example of selecting five rows, how would you get:

row1/col1, row1/col2
row2/col1, row2/col2
etc.

as individual data bits? I am also assuming it would be possible to determine the number of rows selected.

It would be MUCH easier if we could determine:

1. 5 rows (in Excel) selected...therefore make a Word table of rows=6, col=4 (the extra row for the header labels)

2. make a table object (ThisTable) of new table.

Now it is easy to do something like:For var = 1 To rowcount
ThisTable.Cell(var, 1).Range.Text = Excelrow1/col1
ThisTable.Cell(var, 2).Range.Text = Excelrow1/col2with the Excel chunks coming over as variables.

This would completely bypass as that pasting, and converting to text, then converting back to table again.

Further, you could properly insert the formfields into the columns of the new table better.

BTW Strongs, on that point, your code inserts a formfield giving it the name "Text5", and then you copy and paste gobs of them. ALL those formfields have no name.

[lucas]

Gerry,
This example uses the used range from the Excel file. Doc is created based on a Word Template in the same path as the excel file. Reference to the Word object model required.

I use this quite a bit with a different template file.

[Strongs]

Sorry Gerry,

I placed the numbers in the word document by hand and not from the excel worksheet just to give an idea of the range i would be searching for. You are right, under normal conditions and after a sort had been executed, the numbers would be in the correct order.

sorry for the confusion.

[mdmackillop]

This is a bit crude, but limited time. I've disabled your startup macro for demo purposes.


Option Explicit

Sub GetData()
'Requires a Reference to Excel
Dim Pth As String
Dim XL, sh, cel, ws, i

Pth = ActiveDocument.Path
Set XL = GetObject(Pth & "\Sample Text.xls")
Set ws = XL.Sheets(1)

'Fill Table 2
i = 0
Do
i = i + 1
cel = ws.Cells(i, "I")
If cel = "" Then Exit Do
If IsNumeric(cel) Then
myheading = ws.Cells(i, "I") & " " & ws.Cells(i, "K")
If i = 1 Then
ActiveDocument.Tables(2).Cell(3, 1).Select
Selection.Tables.Add _
Range:=Selection.Range, NumRows:=1, NumColumns:=1
Selection.TypeText myheading
Else
Selection.InsertRowsBelow 1
Selection.TypeText myheading
End If
End If
Loop

'Fill Table 5
i = 0
Do
i = i + 1
cel = ws.Cells(i, "I")
If cel = "" Then Exit Do
'text type x.x.1
If UBound(Split(cel, ".")) = 2 And _
Split(cel, ".")(UBound(Split(cel, "."))) = 1 Then
With ActiveDocument.Tables(7)
.Cell(i, 1).Range.InsertAfter ws.Cells(i, "I")
.Cell(i, 2).Range.InsertAfter ws.Cells(i, "K")
.Rows.Add
End With

End If

Loop

'Fill Table 9
i = 1
Do
i = i + 1
cel = ws.Cells(i, "I")
If cel = "" Then Exit Do

With ActiveDocument.Tables(9)
.Cell(i, 1).Range.InsertAfter ws.Cells(i, "I")
.Cell(i, 2).Range.InsertAfter ws.Cells(i, "K")
.Rows.Add
End With
Loop
End Sub

[Strongs]

Hi Malcolm,

thanks for posting the code. I won't get a chance to try it for a few days, but will let you know if it works.

Regards,