Sub MyRandCharColors16M()
Dim oChr As Range

'Use floating point so scaling will work.
'Font.Color will take floating point, but it rounds,
'which messes up the probabilities.
Dim sngR As Single, sngG As Single, sngb As Single
Dim sngRGBSum As Single, sngRGBF As Single

'Define the maximum RGB sum.
'A score around 500-600 seems to give the best results.
'See Random color macro test data.pdf.
Const sngRGBMax As Single = 550
Randomize

'Loop thru characters in selection one at a time.
For Each oChr In Selection.Characters
  sngR = Int(Rnd() * 256) 'Select an integer on [0,255]
  sngG = Int(Rnd() * 256) 'Int is required for equal probability
  sngb = Int(Rnd() * 256) 'Else 0 only gets 0.5 and 255 gets 1.5
  'If the sum > max, scale all three back proportionately
  sngRGBSum = sngR + sngG + sngb
  If sngRGBSum > sngRGBMax Then     'If sum > max, scale it down to max
    sngRGBF = sngRGBMax / sngRGBSum
    sngR = sngR * sngRGBF
    sngG = sngG * sngRGBF
    sngb = sngb * sngRGBF
  End If
  'Assign the next character its color
  oChr.Font.Color = RGB(sngR, sngG, sngb)
Next oChr

End Sub

Sub MyRandCharColors256G()
Dim oChr As Range
Dim sngGrey As Single
Randomize
For Each oChr In Selection.Characters
'  sngGrey = Int(Rnd() * 256) '256 shades of grey
  sngGrey = Int(Rnd() * 192) '192 shades of grey
'  sngGrey = Int(Rnd() * 128) '128 shades of grey
  oChr.Font.Color = RGB(sngGrey, sngGrey, sngGrey)
Next oChr
End Sub