Sub highlight_cell(ByVal rng As Range)
Dim length As Long, color As Long, text As String, separator As String, colors, re As Object
'*** Added - GKMA
Dim lngCol As Long, lngIndex As Long
  lngCol = rng.Column
  'Clear any existing color coding.
  If rng.Interior.color <> 16777215 Then
    rng.Interior.color = 16777215
    lngIndex = 1
    Do While ActiveSheet.Cells(rng.Row, lngCol + lngIndex).Interior.color <> 16777215 And ActiveSheet.Cells(rng.Row, lngCol + lngIndex).Value = ""
      ActiveSheet.Cells(rng.Row, lngCol + lngIndex).Interior.color = 16777215
      lngIndex = lngIndex + 1
    Loop
  End If
'*** End add.
  Set re = CreateObject("VBScript.RegExp")
  re.IgnoreCase = True
  '*** GKM changed to more muted colors (the US blue was difficult to read)
  colors = Array("15985347", "5296274", "65535", "12439801", "6908415", "0")
  separator = Mid(3 / 2, 2, 1)
  text = rng.Value
  If UCase(text) <> "L" Then
    re.Pattern = "^((?:\d*\.)?\d+)(?:|\-)(US|UK|BR|AP).*$"
    If re.test(text) Then
      With re.Execute(text).Item(0)
        text = .SubMatches(0)
        length = Replace(text, ".", separator) / 0.25
        color = colors((InStr(1, "USUKBRAPL", .SubMatches(1), vbTextCompare) - 1) / 2)
      End With
    End If
  Else
    length = 33 - rng.Column + 1
    color = colors(4)
  End If
  '*** Modified GKM
  If lngCol + length <= 34 Then
    If length Then rng.Resize(1, length).Interior.color = color
  Else
    MsgBox "The defined task duration exceeds the shift period."
  End If
  Set re = Nothing
  '*** End mods
End Sub