Issue a letter for every article in a column

[Hansulet]

I have a large data base including over 20 columns (with Place, Name, Personal Code / Insurance Number) and 30000 rows.
For every article in column A, I have to print a letter including rows associated with respective Place.

I tried in MSWord with MailMergeDirectory but I fail.
I hope in Excel the result will be good.

Below, I put an example:

col A col B col C colD col E .............col AM
Place1 Name1 CNP1
Place1 Name2 CNP2
Place1 Name3 CNP3
Place2 Name4 CNP4
Place2 Name5 CNP5
Place2 Name6 CNP6
Place2 Name7 CNP7
Place3 Name8 CNP8
Place3 Name9 CNP9
__________________________________________________________________________________

The letter for Place 1 must be as follows:

Place1

Name1 CNP1
Name2 CNP2
Name3 CNP3
__________________________________________________________________________
The letter for Place 2 must be as follows:

Place2


Name4 CNP4
Name5 CNP5
Name6 CNP6
Name7 CNP7
____________________________________________________________________
The letter for Place 3 must be as follows:

Place3


Name8 CNP8
Name9 CNP9
______________________________________________________________________

 

[Peter_SSs]

The letter for Place 1 must be as follows:

Place1

Name1 CNP1
Name2 CNP2
Name3 CNP3
__________________________________________________________________________
The letter for Place 2 must be as follows:

Place2


Name4 CNP4
Name5 CNP5
Name6 CNP6
Name7 CNP7
____________________________________________________________________
The letter for Place 3 must be as follows:

Place3


Name8 CNP8
Name9 CNP9
______________________________________________________________________

1. Where should these results be placed?

2. Are columns D:AM relevant for (ie included in) the results, or can they be ignored?

3. Does the existing data have headings in row 1?

 

[sdruley]

The best tool for doing what you wish is MailMerge in Word. To get this functionality in Excel would take a bit of work. I would suggest that you go back to Word and study the MailMerge videos that are readily available on the internet.

 

[Akashwani]

Hi,

You could create a Pivot Table from your data, set the Print Area, Set Page Breaks for each Item and you should get each item printed out on a seperate sheet.

Sample Data...

Excel Workbook
	A	B	C	D
1	Place	Name	Personal Code / Insurance Number
2	Place1	Name1	CNP1
3	Place1	Name2	CNP2
4	Place1	Name3	CNP3
5	Place2	Name4	CNP4
6	Place2	Name5	CNP5
7	Place2	Name6	CNP6
8	Place2	Name7	CNP7
9	Place3	Name8	CNP8
10	Place3	Name9	CNP9
11
Sheet7

Sample Pivot Table....

Excel Workbook
	A	B	C
1
2
3
4	Place	Name	Personal Code / Insurance Number
5	Place1	Name1	CNP1
6		Name2	CNP2
7		Name3	CNP3
8	Place2	Name4	CNP4
9		Name5	CNP5
10		Name6	CNP6
11		Name7	CNP7
12	Place3	Name8	CNP8
13		Name9	CNP9
14
15
Sheet8

I hope that helps.

Ak

 

[Hansulet]

Sorry. Inadvertently<small></small>, I fail to mention your request information:

The result will be placed in a different sheet.
The columns D:AM are not relevant. These columns can be ignored.
The data base have a heading in row 1

 

[Peter_SSs]

Sorry. Inadvertently<small></small>, I fail to mention your request information:

The result will be placed in a different sheet.
The columns D:AM are not relevant. These columns can be ignored.
The data base have a heading in row 1

Try this in a copy of your workbook.

My original data is in a sheet called "Data". Change the code to suit your sheet name.

Sub Test()
  Dim c As Range, f As Range
  
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("Data").Copy After:=Sheets("Data")
  With ActiveSheet
    .Name = "Result"
    .Range("A1").CurrentRegion.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=False
    .Rows("1:2").Delete
    Set f = .Columns("B").SpecialCells(xlFormulas)
    For Each c In f
      c.Value = c.Offset(1, -1).Value
    Next c
    f.EntireRow.Insert
    f.Offset(1).EntireRow.Insert
    .UsedRange.RemoveSubtotal
    .Columns("A").Delete
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

My original sheet:

Excel Workbook
	A	B	C
1	col A	col B	col C
2	Place1	Name1	CNP1
3	Place1	Name2	CNP2
4	Place1	Name3	CNP3
5	Place2	Name4	CNP4
6	Place2	Name5	CNP5
7	Place2	Name6	CNP6
8	Place2	Name7	CNP7
9	Place3	Name8	CNP8
10	Place3	Name9	CNP9
11	Place4	Name10	CNP10
12	Place5	Name11	CNP11
13	Place5	Name12	CNP12
14
Data

My results:

Excel Workbook
	A	B	C
1
2	Place1
3
4	Name1	CNP1
5	Name2	CNP2
6	Name3	CNP3
7
8	Place2
9
10	Name4	CNP4
11	Name5	CNP5
12	Name6	CNP6
13	Name7	CNP7
14
15	Place3
16
17	Name8	CNP8
18	Name9	CNP9
19
20	Place4
21
22	Name10	CNP10
23
24	Place5
25
26	Name11	CNP11
27	Name12	CNP12
28
29
Result

 

[sdruley]

Peter,

Great work!

Steve

 

[Hansulet]

Thanks a lot, Peter.
Your code is very helpful for me.
For each place, together with associated rows, can be inserted a sheet renamed as place name?

 

[Peter_SSs]

Thanks a lot, Peter.
Your code is very helpful for me.
For each place, together with associated rows, can be inserted a sheet renamed as place name?

See if this modification is okay.

Sub Test2()
  Dim c As Range, f As Range
  
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("Data").Copy After:=Sheets("Data")
  With ActiveSheet
    .Name = "Result"
    .Range("A1").CurrentRegion.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=False
    .Rows("1:2").Delete
    Set f = .Columns("B").SpecialCells(xlFormulas)
    For Each c In f
      c.Value = c.Offset(1, -1).Value
    Next c
    f.EntireRow.Insert
    .UsedRange.RemoveSubtotal
    .Columns("A").Delete
    For Each c In .Columns("A").SpecialCells(xlConstants).Areas
      Sheets.Add After:=Sheets(Sheets.Count)
      With ActiveSheet
        .Range("A1").Resize(c.Rows.Count, 2).Value = c.Resize(, 2).Value
        On Error Resume Next
        .Name = .Range("A1").Value
        On Error GoTo 0
      End With
    Next c
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

 

[snb_]

or:

Sub M_snb()
  sn = Sheets("sheet1").Cells(1).CurrentRegion

  For j = 1 To UBound(sn) - 1
    c01 = c01 & "," & j
    If sn(j, 1) <> sn(j + 1, 1) Then
      Sheets.Add.Name = sn(j, 1)
      Sheets(sn(j, 1)).Cells(1).Resize(UBound(Split(c01, ",")), 2) = Application.Index(sn, Application.Transpose(Split(Mid(c01, 2), ",")), Array(2, 3))
      c01 = ""
    End If
  Next

  c01 = c01 & "," & j
  Sheets.Add.Name = sn(j, 1)
  Sheets(sn(j, 1)).Cells(1).Resize(UBound(Split(c01, ",")), 2) = Application.Index(sn, Application.Transpose(Split(Mid(c01, 2), ",")), Array(2, 3))
End Sub