find and replace macro

[Philip Thonning Skou]

Hi,
I am designing an inventory report in Word (mail merge)
for a botanic garden. I am trying to make a macro that
can clean up the report a little because there are a lot
of duplicate values. The data will be sorted by family
and then by name.

This is what I have:

Family1
Name1
Location1

Family1
Name2
Location2

Family1
Name2
Location3

Family2
Name3
Location4

This is how I would like it to look:

Family1
Name1
Location1

Name2
Location2
Location3

Family2
Name3
Location4

I know I have to make two passes. One pass that looks for
family and one that looks for name.

Any help would be appreciated.

Philip

 

[Doug Robbins - Word MVP]

Hi Philip,

If you were to create a directory (or in Word 2k and before) catalog type
mailmerge with the mergefields in the first row of a single row table to
produce the following result:

Family 1 Name 1 Location 1
Family 1 Name 2 Location 2
Family 1 Name 2 Location 3
Family 2 Name 3 Location 4

and you ran the following macro over the document, it would create a table
as follows

Family 1
Name 1 Location 1
Name 2 Location 2
Name 2 Location 3
Family 2
Name 3 Location 4

It can probably be modified to give you what you want

' Macro to create multiple items per condition from a directory type
mailmerge

Dim source As Document, target As Document, scat As Range, tcat As Range
Dim data As Range, stab As Table, ttab As Table
Dim i As Long, j As Long, k As Long, n As Long
Set source = ActiveDocument
Set target = Documents.Add
Set stab = source.Tables(1)
k = stab.Columns.Count
Set ttab = target.Tables.Add(Range:=Selection.Range, numrows:=1,
numcolumns:=k - 1)
Set scat = stab.Cell(1, 1).Range
scat.End = scat.End - 1
ttab.Cell(1, 1).Range = scat
j = ttab.Rows.Count
For i = 1 To stab.Rows.Count
Set tcat = ttab.Cell(j, 1).Range
tcat.End = tcat.End - 1
Set scat = stab.Cell(i, 1).Range
scat.End = scat.End - 1
If scat <> tcat Then
ttab.Rows.Add
j = ttab.Rows.Count
ttab.Cell(j, 1).Range = scat
ttab.Rows.Add
For n = 2 To k
Set data = stab.Cell(i, n).Range
data.End = data.End - 1
ttab.Cell(ttab.Rows.Count, n - 1).Range = data
Next n
Else
ttab.Rows.Add
For n = 2 To k
Set data = stab.Cell(i, n).Range
data.End = data.End - 1
ttab.Cell(ttab.Rows.Count, n - 1).Range = data
Next n
End If
Next i


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP