Sub addSentenceColouring()
    Dim docRange As Range
    Dim character As Range
    Dim colourIndex As Integer
    Dim colours() As Variant
    
    ' Disable track changes
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    tr = ActiveDocument.TrackRevisions
    ActiveDocument.TrackRevisions = False
    
    
    ' Define the pastel pale colours using RGB values
    colours = Array(RGB(204, 255, 204), RGB(204, 229, 255), RGB(255, 229, 204), RGB(242, 242, 242), RGB(255, 255, 204))
    
    ' Initialize the color index
    colourIndex = 0
    
    ' Set the document range to the entire ActiveDocument
    Set docRange = ActiveDocument.Content
    
    ' Loop through each character in the document range
    s = 0
    p = 0
    a0 = ""
    For Each character In docRange.Characters
        ' Check if the character is a lone dot
        character.Font.Shading.BackgroundPatternColor = colours(colourIndex Mod 5)
        
        On Error Resume Next
        a = character.text
        b = character.Next.text
        sup = character.Next.Font.Superscript
        On Error GoTo 0
                
        ' Debug.Print p & " " & a
        If IsDot(a0, a, b, sup) Then
            colourIndex = colourIndex + 1
            s = p
        End If
        a0 = a
        p = p + 1
    Next character
    
    
    Set selectedRange = ActiveDocument.Range(Start:=s, End:=p)
    selectedRange.Select
    selectedRange.Font.Shading.BackgroundPatternColor = colours(colourIndex Mod 5)
    
    ActiveDocument.TrackRevisions = tr
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Debug.Print "Colouring done"
End Sub

Function IsDot(ByVal lastchar As String, ByVal char As String, ByVal nextchar As String, ByVal sup As Boolean) As Boolean
    ' Check if the character is a dot
    If lastchar = "." And char = "”" And sup Then
        IsDot = True
    Else
        If (nextchar = " " Or nextchar = Null Or sup) And (char = "." Or char = "!" Or char = "?") And (Not lastchar = ".") Then
            IsDot = True
        Else
            IsDot = False
        End If
    End If
End Function
Sub removeSentenceColouring()
    Dim docRange As Range
    
    Debug.Print "removeSentenceColouring"
    
    ' Disable track changes
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    tr = ActiveDocument.TrackRevisions
    ActiveDocument.TrackRevisions = False
    
    
    Set docRange = ActiveDocument.Content
    p = 0
    For Each character In docRange.Characters
        Set selectedRange = ActiveDocument.Range(Start:=p, End:=p + 1)
        selectedRange.Select
        selectedRange.Font.Shading.BackgroundPatternColor = wdColorAutomatic
        p = p + 1
    Next character
    
    ActiveDocument.TrackRevisions = tr
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Debug.Print "Done"
End Sub