MAIL MERGE - How to shade rows in a table if there are entries with same Ref No

[beginner145]

Hi,

Sorry to bother you - just looking for some assistance with shading rows in a table in an MS Word mail merge document.

The template has 3 columns which data can be merged into using an Excel file as the data source.

The columns are as follows:

Column 1
«FULL_NAME»
ELECTOR ID - «ELECTOR_ID»
HOUSE ID - «HOUSE_ID»

Column 2
«FULL_CORR_ADDRESS»

Column 3
«LETTER_TYPE»

The first part of the job I was trying to achieve was to create a macro which will shade the cell in column 3 of the table depending on the data merged into it for «LETTER_TYPE». I got the following code to work:

Sub ColourCells()
Dim oTbl As Table
Dim oCel As Cell
Dim oRng As Range
For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Range.Cells
Set oRng = oCel.Range
oRng.End = oRng.End - 1


Select Case oRng.Text
Case "HEF"
oCel.Shading.BackgroundPatternColorIndex = wdRed
Case "ITR"
oCel.Shading.BackgroundPatternColorIndex = wdYellow

Case "ITR-NR"
oCel.Shading.BackgroundPatternColorIndex = wdBlue
End Select


Next
Next
End Sub


The above code was copied from another post on this forum, I tweaked it a bit and with a little bit of trial and error I got it to work - apologuies, I can't remember who posted it originally, but many thanks for the hints.

The data will mostly have one entry for each property, the «HOUSE_ID» is unique to each property.

However, there are some instances where the property appears twice in the data and will in turn merge into the template. I do want this to happen as they will be signifying different values for the «LETTER_TYPE» field and one of them will not be relevant to an elector. I have sorted the data file into «HOUSE_ID» order so that when they are merged into the template they appear beside each other.

What I'm trying to do now is to shade the cells in columns 1, 2 & 3 in both rows if the «HOUSE_ID» appears in the merged document more than once. I'm not sure how to go about comparing the current record «HOUSE_ID» with the previous record - I'm not even sure if this is how I'd go about it.

Apologies for my rather long post and I hope it makes sense. I'm a bit of a beginner. If any clarification is needed, please let me know.

Many thanks

[macropod]

You don't need a macro for the basic HEF/ITR/ITR-NF shading - the mailmerge can provide the same effect without one. Although Word doesn’t have tools for the kind of conditional cell formatting one finds in Excel, the effect can be simulated via field coding that combines tab-stops and manual line breaks inside an IF test that conditionally outputs the various strings. Such a field might be coded like:
{IF«LETTER_TYPE» = "HEF" {QUOTE "^t^t↵
^t«LETTER_TYPE»^t↵
^t^t" \* Charformat}}
with one such field per «LETTER_TYPE». Collectively, these would end up as
{IF«LETTER_TYPE» = "HEF" {QUOTE "^t^t↵
^t«LETTER_TYPE»^t↵
^t^t" \* Charformat}}{IF«LETTER_TYPE» = "ITR" {QUOTE "^t^t↵
^t«LETTER_TYPE»^t↵
^t^t" \* Charformat}}{IF«LETTER_TYPE» = "ITR-NR" {QUOTE "^t^t↵
^t«LETTER_TYPE»^t↵
^t^t" \* Charformat}}

Note: Instead of the ↵ and ^t depicted above, you should use real line-breaks and tabs, respectively.

The foregoing construction could be used to output the «LETTER_TYPE» text, horizontally and vertically centred in the cell. The cell shading is achieved by highlighting the bold Qs in the shades required (I've coloured the text here, because I can't apply highlighting for the forum). The centring is achieved by using centred tab-stops, plus right-aligned tab-stops to extend each line to the cell border. An empty line above and below the output string is also inserted. Obviously, the cell would need a fixed width and you would also need to specify a 0-width internal border.

You can do something similar for the «HOUSE_ID» fields, but the shading would only apply to the 2nd & subsequent repeats - the first instance would be unshaded. To do that, you'd insert a field coded as:
{IF{MERGESEQ}= 1 {SET Rpt ""}}
at the top of the document. Then, in the cells to be shaded, you'd use field coding like:
{IF«HOUSE_ID»= {REF Rpt} {QUOTE "^t^t↵
^t«FULL_NAME»↵
ELECTOR ID - «ELECTOR_ID» ↵
HOUSE ID - «HOUSE_ID»^t↵
^t^t" \* Charformat} {QUOTE "^t^t↵
^t«FULL_NAME»↵
ELECTOR ID - «ELECTOR_ID» ↵
HOUSE ID - «HOUSE_ID»^t↵
^t^t{SET Rpt «HOUSE_ID»}"}}

If you're wedded to using a macro, you'd need to store the HouseID text found in column 1 of each table, then compare that against the same text in the next table. Then, if they're the same, shade either or both.

[beginner145]

Hi - many thanks for your reply.

Sorry, I forgot, I should have mentioned in my initial post that the data held in the LETTER_TYPE column in the datasource has various codess, e.g. HEF1rP and HEF1rB which should both merge into the document as "HEF". ITR1r should merge in as ITR. ITR-NR should merge in as ITR-NR. I have the merge successfully doing this and then when the macro I posted earlier is run it successfully colour codes the appropriate cells.

Thanks very much for your advice, I'm not very clued up with codes etc, but think I would prefer to use macros.

You say that I would need to store the HouseID text found in column 1 of each table, then compare that against the same text in the next table. Then, if they're the same, shade either or both.

How would I do this?

Thanks again.

[macropod]

Try:

Sub TableShader()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long, Rng As Range, StrTxt As String
For Each Tbl In ActiveDocument.Tables
StrTxt = ""
With Tbl
For i = 1 To .Rows.Count
With .Cell(i, 1)
Set Rng = .Range
With Rng
.End = .End - 1
.Start = .Words.Last.Start
End With
If Rng.Text = StrTxt Then
.Row.Shading.BackgroundPatternColorIndex = wdBrightGreen
Tbl.Cell(i - 1, 1).Row.Shading.BackgroundPatternColorIndex = wdBrightGreen
Else
StrTxt = Rng.Text
End If
End With
Next
For i = 1 To .Rows.Count
With .Cell(i, 3)
Set Rng = .Range
With Rng
.End = .End - 1
End With
Select Case Rng.Text
Case "HEF": .Shading.BackgroundPatternColorIndex = wdRed
Case "ITR": .Shading.BackgroundPatternColorIndex = wdYellow
Case "ITR-NR": .Shading.BackgroundPatternColorIndex = wdBlue
End Select
End With
Next
End With
Next
Application.ScreenUpdating = True
End Sub

[beginner145]

Hi - this code brings up a Run-time error '5941'

The requested member of the collection does not exist.

Then when I click Debug, it opens up the VBA code and had With .Cell (i,1) highlighted yellow.


Try:

Sub TableShader()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long, Rng As Range, StrTxt As String
For Each Tbl In ActiveDocument.Tables
StrTxt = ""
With Tbl
For i = 1 To .Rows.Count
With .Cell(i, 1)
Set Rng = .Range
With Rng
.End = .End - 1
.Start = .Words.Last.Start
End With
If Rng.Text = StrTxt Then
.Row.Shading.BackgroundPatternColorIndex = wdBrightGreen
Tbl.Cell(i - 1, 1).Row.Shading.BackgroundPatternColorIndex = wdBrightGreen
Else
StrTxt = Rng.Text
End If
End With
Next
For i = 1 To .Rows.Count
With .Cell(i, 3)
Set Rng = .Range
With Rng
.End = .End - 1
End With
Select Case Rng.Text
Case "HEF": .Shading.BackgroundPatternColorIndex = wdRed
Case "ITR": .Shading.BackgroundPatternColorIndex = wdYellow
Case "ITR-NR": .Shading.BackgroundPatternColorIndex = wdBlue
End Select
End With
Next
End With
Next
Application.ScreenUpdating = True
End Sub

[macropod]

It works fine for me. See attached. Of course, if your table doesn't have a uniform column/row layout (something you haven't mentioned), that might cause problems.

[beginner145]

Sorry, beginner not thinking on everything again. The template has merged cells - that would affect it, wouldn't it?

OK if I show you the template?

Many thanks

[macropod]

The template has merged cells - that would affect it, wouldn't it?
Definitely.

OK if I show you the template?
By all means, do!

[beginner145]

Thanks very much for taking time to help and have a look - I've attached a sample of what the merge will produce.
12549

[macropod]

Try:

Sub TableShader()
Application.ScreenUpdating = False
Dim Tbl As Table, oCell As Cell, bShd As Boolean, Rng As Range, StrTxt As String
For Each Tbl In ActiveDocument.Tables
StrTxt = "": bShd = False
With Tbl.Range
For Each oCell In .Cells
With oCell
If .ColumnIndex = 1 Then
Set Rng = .Range
With Rng
.End = .End - 1
.Start = .Words.Last.Start
End With
If Rng.Text = StrTxt Then
bShd = True
Else
bShd = False
StrTxt = Rng.Text
End If
End If
If bShd = True Then
If .ColumnIndex <> 3 Then
.Shading.BackgroundPatternColorIndex = wdBrightGreen
On Error Resume Next
Tbl.Cell(.RowIndex - 2, .ColumnIndex).Shading.BackgroundPatternColorIndex = wdBrightGreen
On Error GoTo 0
End If
End If
If .ColumnIndex = 3 Then
Set Rng = .Range
With Rng
.End = .End - 1
End With
Select Case Rng.Text
Case "HEF": .Shading.BackgroundPatternColorIndex = wdRed
Case "ITR": .Shading.BackgroundPatternColorIndex = wdYellow
Case "ITR-NR": .Shading.BackgroundPatternColorIndex = wdBlue
End Select
End If
End With
Next
End With
Next
Application.ScreenUpdating = True
End Sub

[beginner145]

That works brilliantly - thank you very much.

Just a couple of things - I don't want it to shade the whole row bright green, only up to and including the column containing the HEF/ITR wording. [

Also, it is also highlighting blank rows at the end of the merged document bright green. I wouldn't want it to do this.

Thanks again. QUOTE=macropod;317971]Try:

Sub TableShader()
Application.ScreenUpdating = False
Dim Tbl As Table, oCell As Cell, bShd As Boolean, Rng As Range, StrTxt As String
For Each Tbl In ActiveDocument.Tables
StrTxt = "": bShd = False
With Tbl.Range
For Each oCell In .Cells
With oCell
If .ColumnIndex = 1 Then
Set Rng = .Range
With Rng
.End = .End - 1
.Start = .Words.Last.Start
End With
If Rng.Text = StrTxt Then
bShd = True
Else
bShd = False
StrTxt = Rng.Text
End If
End If
If bShd = True Then
If .ColumnIndex <> 3 Then
.Shading.BackgroundPatternColorIndex = wdBrightGreen
On Error Resume Next
Tbl.Cell(.RowIndex - 2, .ColumnIndex).Shading.BackgroundPatternColorIndex = wdBrightGreen
On Error GoTo 0
End If
End If
If .ColumnIndex = 3 Then
Set Rng = .Range
With Rng
.End = .End - 1
End With
Select Case Rng.Text
Case "HEF": .Shading.BackgroundPatternColorIndex = wdRed
Case "ITR": .Shading.BackgroundPatternColorIndex = wdYellow
Case "ITR-NR": .Shading.BackgroundPatternColorIndex = wdBlue
End Select
End If
End With
Next
End With
Next
Application.ScreenUpdating = True
End Sub[/QUOTE]

[macropod]

To limit the shaded columns, simply change:
If .ColumnIndex <> 3 Then
to:
If .ColumnIndex < 3 Then

To prevent the shading of rows lacking a house ID number, insert:
If Not IsNumeric(Rng.Text) Then bShd = False
before:
If bShd = True Then

[beginner145]

That's working brilliantly and exactly as required.

Is there a way to get this macro to run automatically? I'd like it to run once the user has done Finish & Merge - Edit Individual Documents - Merge to New Document and clicked OK. [

QUOTE=macropod;317977]To limit the shaded columns, simply change:
If .ColumnIndex <> 3 Then
to:
If .ColumnIndex < 3 Then

To prevent the shading of rows lacking a house ID number, insert:
If Not IsNumeric(Rng.Text) Then bShd = False
before:
If bShd = True Then[/QUOTE]

[macropod]

There is, but doing so creates a whole new layer of complexity, requiring the creation of a class module, the instantiation of the class and calling the MailMergeAfterMerge event. A far simpler approach would be to add some code to the macro to run the merge, then do the processing on the output document. At its most basic, all you'd need for that is to insert:

With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
before:
For Each Tbl In ActiveDocument.Tables
Then create a keyboard shortcut for the macro.

[beginner145]

That's perfect. It works exactly as needed.

Many thanks for your help and patience.

[beginner145]

Sorry, just some minor tweaking to the code needed.

Is it possible to change the colours of the shading as follows:

HEF - Olive Green, Accent 3, Lighter 80%
ITR - Purple, Accent 4, Lighter 80%
ITR-NR - Aqua, Accent 5, Lighter 80%
Duplicate Entries - Orange, Accent 6, Lighter 80%

These are the colours/descriptions of the shading that have been used on the example provided to me.

Is this possible?

Thanks

[beginner145]

After a bit of googling and trial and error the code is now shading as I want it and now looks like this:
Sub TableShader()
Application.ScreenUpdating = False
Dim Tbl As Table, oCell As Cell, bShd As Boolean, Rng As Range, StrTxt As String
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
For Each Tbl In ActiveDocument.Tables
StrTxt = "": bShd = False
With Tbl.Range
For Each oCell In .Cells
With oCell
If .ColumnIndex = 1 Then
Set Rng = .Range
With Rng
.End = .End - 1
.Start = .Words.Last.Start
End With
If Rng.Text = StrTxt Then
bShd = True
Else
bShd = False
StrTxt = Rng.Text
End If
End If
If Not IsNumeric(Rng.Text) Then bShd = False
If bShd = True Then
If .ColumnIndex = 2 Then
.Shading.BackgroundPatternColor = RGB(255, 234, 218)
On Error Resume Next
Tbl.Cell(.RowIndex - 2, .ColumnIndex).Shading.BackgroundPatternColor = RGB(255, 234, 218)
On Error GoTo 0
End If
End If
If .ColumnIndex = 3 Then
Set Rng = .Range
With Rng
.End = .End - 1
End With
Select Case Rng.Text
Case "HEF": .Shading.BackgroundPatternColor = RGB(235, 241, 222)
Case "ITR": .Shading.BackgroundPatternColor = RGB(230, 224, 236)
Case "ITR-NR": .Shading.BackgroundPatternColor = RGB(216, 237, 242)
End Select
End If
End With
Next
End With
Next
Application.ScreenUpdating = True
End Sub

[macropod]

You can change the colours to whatever you like, by changing:
BackgroundPatternColorIndex
to:
.BackgroundPatternColor
and specifying the RGB values. For example:
.BackgroundPatternColor = RGB(255, 192, 0)
where the numbers, from 0 to 255, are inserted for the Red, Green and Blue values respectively.
Olive Green, Accent 3, Lighter 80% = RGB(234, 241, 221)
Purple, Accent 4, Lighter 80% = RGB(229, 223, 236)
Aqua, Accent 5, Lighter 80% = RGB(218, 238, 243)
Orange, Accent 6, Lighter 80% = RGB(253, 233, 217)

PS: When posting code, please use the code tags, indicated by the # button on the posting menu.

[beginner145]

Hi,

Sorry to bother you again with regard to this coding.

I refer back to this (which is working, all be it still needing a slight tweak) - shading the cell if the «HOUSE_ID» appears in the merged document more than once.

It is working where the duplicates are on the same page, but when the first occurrence appears on the last row of the merged document and then then next occurrence appears in the first row on the next page of the merged document - neither of the entries are being shaded.

Would you be able to advise how this could be resolved.

Thanks

[macropod]

The problem you're having is that the tables are separate, not a single table, and the macro processes each table separately. The simplest solution is to change the merge type to a directory merge and delete all except the first row of the table from the mailmerge main document.

[beginner145]

It is set up as a directory with the headings at the top of the page. Would having the headings and one single row containing the mergefields mean that the headings would reproduce at the top of each page?

[macropod]

Unless you're adding the headings to each page after running the merge, I can't see how those results are possible. If that is what you're doing, you should only be adding the heading rows to the first page and using the table 'heading rows' option to automatically display the table header on every page.

[beginner145]

Sorry to bump an old thread, another bit of development with this that I'm having trouble with.

If we were to merge the whole data file into the template at once, is there an automatic way to then split/page break each time the POLLING_DISTRICT changes. For example, the first 100 or so entries could all be POLLING_DISTRICT value AA01, then the next POLLING_DISTRICT value is AA02 etc. Then force AA02 entries to start on a new page.

Or automatically split/save each POLLING_DISTRICT as a new file and automatically giving it the filename of the POLLING_DISTRICT value?

Hope this makes sense.

Thanks