I'm on a corporate network that blocks google drive so I can't see your file.
I'm assuming you want to get a list of the shadings applied throughout the document. The following shows how I would identify the shadings which exist in the document. It is unlikely to be fast in large documents. It will most likely return undefined if shading varies within a Word but it is going to be faster than stepping through characters.
If this is what you are trying to get to, you should eliminate the duplicates before using the other code you already have.
Code:
Sub FindAllShades()
Dim aWord As Range, lPatt As Long, sList As String
For Each aWord In ActiveDocument.Words
If lPatt <> aWord.Font.Shading.BackgroundPatternColor Then
lPatt = aWord.Font.Shading.BackgroundPatternColor
sList = sList & lPatt & "|"
End If
Next aWord
Debug.Print sList
'use split to break this up into an array for stepping through the possibilities
End Sub