Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 12/2/2018 Dim lngY As Long, lngN As Long, lngNA As Long, lngNullorInvalid As Long Dim oCC As ContentControl Dim oRng As Range For Each oCC In ActiveDocument.Range.ContentControls Select Case oCC.Type Case 8 ' If oCC.Checked Then ' lngY = lngY + 1 ' Else ' lngN = lngN + 1 ' End If Case 3, 4 Select Case oCC.Range.Text Case Is = "Y": lngY = lngY + 1: oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorGreen Case Is = "N": lngN = lngN + 1: oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorBlue Case Is = "NA": lngNA = lngNA + 1: oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorYellow Case Else: lngNullorInvalid = lngNullorInvalid + 1: oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorRed End Select End Select Next oCC Set oRng = ActiveDocument.Range oRng.Collapse wdCollapseEnd oRng.InsertBefore vbCr & "There are " & lngY & " checked or Y responses" oRng.Font.ColorIndex = wdGreen Set oRng = ActiveDocument.Range oRng.Collapse wdCollapseEnd oRng.InsertBefore vbCr & "There are " & lngN & " unchecked or N responses." oRng.Font.ColorIndex = wdBlue Set oRng = ActiveDocument.Range oRng.Collapse wdCollapseEnd oRng.InsertBefore vbCr & "There are " & lngNA & " NA responses" oRng.Font.ColorIndex = wdYellow Set oRng = ActiveDocument.Range oRng.Collapse wdCollapseEnd oRng.InsertBefore vbCr & "There are " & lngNullorInvalid & " blank or invalid responses" oRng.Font.ColorIndex = wdRed lbl_Exit: Exit Sub End Sub