Automatic copy of VBA to mail merged letters

[lukestkd]

Reposted from incorrect section (LINK)

Hello all,
I have a set of code that colours cells based on their values (MMY/MMI/MMN), to show students whether they have completed a task or not. The code is stored in the mail merge document itself, but when I run the merge and the new 'letters' are created the code has to be manually copied into the VBA window. Is there a way of automatically inserting the VBA into the mail merged letters as some non-techhies will be using this system!

Many thanks

Luke

Sub HighlightTargetsMMN()
Dim Rng As Range, i As Long, TargetList
TargetList = Array("MMN") ' put list of terms to find here
For i = 0 To UBound(TargetList)
  Set Rng = ActiveDocument.Range
  With Rng
    With .Find
      .Text = TargetList(i)
      .Format = True
      .MatchCase = True
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Forward = True
      .Wrap = wdFindStop
      .Execute
    End With
    Do While .Find.Found
      .HighlightColorIndex = wdRed
      With .Font
        .Bold = True
        .ColorIndex = wdRed
        .Name = "TW Cen MT"
        .Size = 14
      End With
      If .Information(wdWithInTable) = True Then
        .Cells(1).Shading.BackgroundPatternColorIndex = wdRed
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
End Sub
Sub HighlightTargetsMMI()
Dim Rng As Range, i As Long, TargetList
TargetList = Array("MMI") ' put list of terms to find here
For i = 0 To UBound(TargetList)
  Set Rng = ActiveDocument.Range
  With Rng
    With .Find
      .Text = TargetList(i)
      .Format = True
      .MatchCase = True
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Forward = True
      .Wrap = wdFindStop
      .Execute
    End With
    Do While .Find.Found
      .HighlightColorIndex = wdYellow
      With .Font
        .Bold = True
        .ColorIndex = wdYellow
        .Name = "TW Cen MT"
        .Size = 14
      End With
      If .Information(wdWithInTable) = True Then
        .Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
End Sub
Sub HighlightTargetsMMY()
Dim Rng As Range, i As Long, TargetList
TargetList = Array("MMY") ' put list of terms to find here
For i = 0 To UBound(TargetList)
  Set Rng = ActiveDocument.Range
  With Rng
    With .Find
      .Text = TargetList(i)
      .Format = True
      .MatchCase = True
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Forward = True
      .Wrap = wdFindStop
      .Execute
    End With
    Do While .Find.Found
      .HighlightColorIndex = wdBrightGreen
      With .Font
        .Bold = True
        .ColorIndex = wdGreen
        .Name = "TW Cen MT"
        .Size = 14
      End With
      If .Information(wdWithInTable) = True Then
        .Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
End Sub

Sub fullmacros()
HighlightTargetsMMN
HighlightTargetsMMY
HighlightTargetsMMI
End Sub

Update 22/5 - cross posted at http://www.vbaexpress.com/forum/show...762#post309762