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
cross posted on excel forum (unable to post link)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


Reply With Quote
