Rows to Colums for Mail Merge

  • Thread starter Thread starter EJBNYC
  • Start date Start date
E

EJBNYC

Hello All, I tend to run into this issue a lot when prepping excel data for a
mail merge. My data tends to be supplied in rows while mail merge likes
columns. I hope someone can help me.

Column A contains Domains
Column B contains unique Sites within those domains.

There is one row for each unique site. As there can be multiple sites in
each domain column A contains repeats, sometimes more then 20.
I would like for all values in column B where column A is the same to be
transposed into the row of the first instance of that Domain.

IE:
A B
Domain.1 Domain.1.site.A
Domain.2 Domain.2.site.A
Domain.2 Domain.2.site.B
Domain.2 Domain.2.site.C
Domain.3 Domain.3.site.A

Would become…

A B C D
Domain.1 Domain.1.site.A
Domain.2 Domain.2.site.A Domain.2.site.B Domain.2.site.C
Domain.3 Domain.3.site.A
 
Thanks Macro. I’m afraid my case is a bit more complicated as the excel sheet
also contains the e-mail address for whom the messages are intended. Maybe I
should have made it clear that I am doing an e-mail type merge. In any case,
my needs are the same. I need to get all rows that match the “key field
(Column A)†to transpose to columns so mail merge can consider it one record
and ergo, one recipient yet include in one e-mail all instances of sites for
that one domain. To complicate this further, each site has unique recipients
which I plan on concatenating into one entry using the logical function I am
looking for here.
 
Hi EJBNYC,

In that case, you could you a macro like the following to output the sorted records from your current data worksheet (assumed to be
the first in the workbook) on another worksheet (assumed to be the second), which then becomes the data source for your mailmerge).
If need be, you can change the input & output worksheet indexes.

Sub ParseMergeRecords()
Dim i As Integer
Dim x As Integer
Dim y As Integer
x = 0
With ThisWorkbook.Worksheets(1)
For i = 2 To .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
If .Cells(i, 1).Value <> .Cells(i - 1, 1).Value Then
x = x + 1
y = 1
ThisWorkbook.Worksheets(2).Cells(x, y).Value = .Cells(i - 1, 1).Value
Else
y = y + 1
ThisWorkbook.Worksheets(2).Cells(x, y).Value = .Cells(i - 1, 2).Value
End If
Next
End With
End Sub
 
Oops! Try:

Sub SortRecords()
Dim i As Integer
Dim x As Integer
Dim y As Integer
x = 0
With ThisWorkbook.Worksheets(1)
For i = 2 To .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
If .Cells(i, 1).Value <> .Cells(i - 1, 1).Value Then
x = x + 1
y = 1
ThisWorkbook.Worksheets(2).Cells(x, y).Value = .Cells(i - 1, 1).Value
y = y + 1
ThisWorkbook.Worksheets(2).Cells(x, y).Value = .Cells(i - 1, 2).Value
Else
y = y + 1
ThisWorkbook.Worksheets(2).Cells(x, y).Value = .Cells(i - 1, 2).Value
End If
Next
End With
End Sub
 
Back
Top