Try the attached. I needed to make some minor changes to your table (including restoration of the placeholder texts), but that won't affect its utility.
Note: If you want to shade the output cells to match the ratings, you could change:
Code:
.Range.Tables(1).Cell(r, c).Range.Text = StrTxt
to:
Code:
With .Range.Tables(1).Cell(r, c)
.Range.Text = StrTxt
.Shading.BackgroundPatternColor = Tbl.Cell(i + 1, j + 1).Shading.BackgroundPatternColor
End With
Do note, though, that this will apply the light grey shading to those cells if you click through them without making a selection. Making that the default state might work for you.