Sub blah()
Set RngToCheck = Range("D13:AB63")
'clear triangles:
For Each shp In ActiveSheet.Shapes
  If Not Intersect(shp.TopLeftCell, RngToCheck) Is Nothing Then shp.Delete
Next shp

'new triangles:
For Each cll In RngToCheck.Cells
  Select Case UCase(Left(cll.Value, 1))
    Case "X"
      AddTriangle cll, "AM", "ABSENT"
    Case "T"
      AddTriangle cll, "AM", "TARDY"
    Case "C"
      AddTriangle cll, "AM", "CUTTING CLASSES"
  End Select
  x = Application.Search("x", cll.Value, 2)
  t = Application.Search("t", cll.Value, 2)
  c = Application.Search("c", cll.Value, 2)
  If Not IsError(x) Then
    AddTriangle cll, "PM", "ABSENT"
  End If
  If Not IsError(t) Then
    AddTriangle cll, "PM", "TARDY"
  End If
  If Not IsError(c) Then
    AddTriangle cll, "PM", "CUTTING CLASSES"
  End If
Next cll
End Sub


Sub AddTriangle(myCell, ampm, TardyAbsent)
 Set myshape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, myCell.Left, myCell.Top, myCell.Width, myCell.Height)
Set yyy = myshape.Nodes
If UCase(ampm) = "AM" Then
  yyy.Delete (3)    'delete bottom right node
Else
  yyy.Delete (5)
  yyy.Delete (1)
End If
Select Case UCase(TardyAbsent)
  Case "TARDY"
    myshape.Fill.ForeColor.RGB = 13998939    'blue
  Case "ABSENT"
    myshape.Fill.ForeColor.RGB = 255    'red
  Case "CUTTING CLASSES"
    myshape.Fill.ForeColor.RGB = 65535    'yellow
End Select
myshape.Line.Visible = msoFalse
End Sub