Tables Selective Merge

Hi I am trying to write a macro for a word problem. I have 2 tables like below:

Heading 1 Heading 1
Name
Abcdef abcdef abcdef abcdef
Data
Data
Data
Data


1 Xyz Juhdfjjknb
2 Def Dijwhcjco
3 Hgt Jascnjxnksjnx
4 Wxy Osuhchc ciwjqsdioj


I have to take the first 2 rows of the first table and merge it with the
first 3 columns of the second table in a new table with 5 columns. This is
tobe repeated 400 times with tables with similar data. The final table should
be like below:

Heading 2 Heading 2 Heading 2 Heading 2 Heading 2
Name Abcdef abcdef abcdef abcdef 1 Xyz Juhdfjjknb
2 Def Dijwhcjco
3 Hgt Jascnjxnksjnx
4 Wxy Osuhchc

Any ideas about how this could be done?

Giri

Doug
Thu Jan 17 11:51:55 PST 2008

You sample of what you should end up with does not match your description.
Did you mean it to be:

Heading 1 Heading 2 Heading 3 Heading 4 Heading 5
Name Abcdef (etc.) 1 Xyz (etc.) 2 Def (etc.) 3 Hgt (etc)



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

"Giri" <Giri@discussions.microsoft.com> wrote in message
news:64EFB023-4635-49D5-A753-1ADAA562C1C1@microsoft.com...
> Hi I am trying to write a macro for a word problem. I have 2 tables like
> below:
>
> Heading 1 Heading 1
> Name
> Abcdef abcdef abcdef abcdef
> Data
> Data
> Data
> Data
>
>
> 1 Xyz Juhdfjjknb
> 2 Def Dijwhcjco
> 3 Hgt Jascnjxnksjnx
> 4 Wxy Osuhchc ciwjqsdioj
>
>
> I have to take the first 2 rows of the first table and merge it with the
> first 3 columns of the second table in a new table with 5 columns. This is
> tobe repeated 400 times with tables with similar data. The final table
> should
> be like below:
>
> Heading 2 Heading 2 Heading 2 Heading 2 Heading 2
> Name Abcdef abcdef abcdef abcdef 1 Xyz Juhdfjjknb
> 2 Def Dijwhcjco
> 3 Hgt Jascnjxnksjnx
> 4 Wxy Osuhchc
>
> Any ideas about how this could be done?
>
> Giri
>
>

David
Thu Jan 17 12:06:01 PST 2008

>This is to be repeated 400 times with tables with similar data.

Is this repeated in the same document or in 400 documents?

This merges into a new document. You said "in a new table", but you
didn't say if it had to be in the same document. I assumed not.

This seems to work, however, I've got a feeling you will need
something more dynamic.

Sub MergeTables()

Dim aDoc As Document
Dim SrcDoc As Document
Dim tbl1 As Table
Dim tbl2 As Table
Dim Tbl1Rng As Range
Dim Tbl2Rng As Range
Dim A As Integer
Dim B As Integer
Dim C As Integer

Dim MyText$

Set aDoc = ActiveDocument
Set tbl1 = aDoc.Tables(1)
Set tbl2 = aDoc.Tables(2)

Set SrcDoc = Documents.Add

SrcDoc.Range.InsertAfter _
"HD2,HD2,HD2,HD2,HD2" & vbCr

'First Row
For A = 2 To 3
Set Tbl1Rng = tbl1.Cell(A, 1).Range
'Remove end of cell marker
Tbl1Rng.MoveEnd wdCharacter, -1
MyText$ = MyText$ & "," & Tbl1Rng
Next
'Remove first comma
MyText$ = Mid(MyText$, 2, Len(MyText$))

For C = 1 To 3
Set Tbl2Rng = tbl2.Cell(1, C).Range
Tbl2Rng.MoveEnd wdCharacter, -1
MyText$ = MyText$ & "," & Tbl2Rng
Next

SrcDoc.Range.InsertAfter MyText$ & vbCr ' Row 1

'Subsequent rows
For B = 2 To 4
MyText$ = ","
For C = 1 To 3
Set Tbl2Rng = tbl2.Cell(B, C).Range
Tbl2Rng.MoveEnd wdCharacter, -1
MyText$ = MyText$ & "," & Tbl2Rng
Next
MyText$ = Mid(MyText$, 2, Len(MyText$))
SrcDoc.Range.InsertAfter "," & MyText$ & vbCr
Next

Set aDoc = Nothing
Set Tbl1Rng = Nothing
Set Tbl2Rng = Nothing

With SrcRng.Range
.ConvertToTable ","
End With
End Sub

Giri
Thu Jan 17 12:50:02 PST 2008

Thanks,

Davd and Doug. The data (400 different tables) are from the same document
and a new table is to be created in a different document.

This was exactly what I was looking for.

"David Sisson" wrote:

> >This is to be repeated 400 times with tables with similar data.
>
> Is this repeated in the same document or in 400 documents?
>
> This merges into a new document. You said "in a new table", but you
> didn't say if it had to be in the same document. I assumed not.
>
> This seems to work, however, I've got a feeling you will need
> something more dynamic.
>
> Sub MergeTables()
>
> Dim aDoc As Document
> Dim SrcDoc As Document
> Dim tbl1 As Table
> Dim tbl2 As Table
> Dim Tbl1Rng As Range
> Dim Tbl2Rng As Range
> Dim A As Integer
> Dim B As Integer
> Dim C As Integer
>
> Dim MyText$
>
> Set aDoc = ActiveDocument
> Set tbl1 = aDoc.Tables(1)
> Set tbl2 = aDoc.Tables(2)
>
> Set SrcDoc = Documents.Add
>
> SrcDoc.Range.InsertAfter _
> "HD2,HD2,HD2,HD2,HD2" & vbCr
>
> 'First Row
> For A = 2 To 3
> Set Tbl1Rng = tbl1.Cell(A, 1).Range
> 'Remove end of cell marker
> Tbl1Rng.MoveEnd wdCharacter, -1
> MyText$ = MyText$ & "," & Tbl1Rng
> Next
> 'Remove first comma
> MyText$ = Mid(MyText$, 2, Len(MyText$))
>
> For C = 1 To 3
> Set Tbl2Rng = tbl2.Cell(1, C).Range
> Tbl2Rng.MoveEnd wdCharacter, -1
> MyText$ = MyText$ & "," & Tbl2Rng
> Next
>
> SrcDoc.Range.InsertAfter MyText$ & vbCr ' Row 1
>
> 'Subsequent rows
> For B = 2 To 4
> MyText$ = ","
> For C = 1 To 3
> Set Tbl2Rng = tbl2.Cell(B, C).Range
> Tbl2Rng.MoveEnd wdCharacter, -1
> MyText$ = MyText$ & "," & Tbl2Rng
> Next
> MyText$ = Mid(MyText$, 2, Len(MyText$))
> SrcDoc.Range.InsertAfter "," & MyText$ & vbCr
> Next
>
> Set aDoc = Nothing
> Set Tbl1Rng = Nothing
> Set Tbl2Rng = Nothing
>
> With SrcRng.Range
> .ConvertToTable ","
> End With
> End Sub
>