Worksheet code (sheet1 in this instance). Run sub TestAddMarkers to add the
worksheet shapes which you can then click to run the OnAction code.

Option Explicit

Public Sub TestAddMarkers()

Marker_AddMarkers Sheet1.Range("A1:A5"), "Sheet1.ToggleMarker"

End Sub

Public Sub ToggleMarker()

Dim Count As Long
Dim MarkerCount As Long

Marker_HandleMarkerClick Sheet1.Shapes(Application.Caller)
Marker_SetMarkersInRange Sheet1.Range("A1:A5")

End Sub

-----------------------------------------------

Module level code detailed below...

Option Explicit

Public Enum tColorIndex
' Colors are in same order as on color pallete, down and across
mxlAutomaticColor = 0
mxlNoColor = -4142
mxlBlack = 1
mxlDarkRed = 9
mxlRed = 3
mxlPink = 7
mxlRose = 38
mxlBrown = 53
mxlOrange = 46
mxlLightOrange = 45
mxlGold = 44
mxlTan = 40
mxlOliveGreen = 52
mxlDarkYellow = 12
mxlLime = 43
mxlYellow = 6
mxlLightYellow = 36
mxlDarkGreen = 51
mxlGreen = 10
mxlSeaGreen = 50
mxlBrightGreen = 4
mxlLightGreen = 35
mxlDarkTeal = 49
mxlTeal = 14
mxlAqua = 42
mxlTurquoise = 8
mxlLightTurquoise = 34
mxlDarkBlue = 11
mxlBlue = 5
mxlLightBlue = 41
mxlSkyBlue = 33
mxlPaleBlue = 37
mxlIndigo = 55
mxlBlueGray = 47
mxlViolet = 13
mxlPlum = 54
mxlLavender = 39
mxlGray80 = 56
mxlGray50 = 16
mxlGray40 = 48
mxlGray25 = 15
mxlWhite = 2
' Chart Fill colors as shown on the color palatte
mxlChartFillPastelBlue = 17
mxlChartFillPlum = 18
mxlChartFillLightTan = 19
mxlChartFillLightTurquoise = 20
mxlChartFillDarkViolet = 21
mxlChartFillPastelPink = 22
mxlChartFillDarkerLightBlue = 23
mxlChartFillLightBueGray = 24
' Chart Line colors as shown on the color palatte
mxlChartLineDarkBlue = 25
mxlChartLinePink = 26
mxlChartLineYellow = 27
mxlChartLineTurquoise = 28
mxlChartLineViolet = 29
mxlChartLineDarkRed = 30
mxlChartLineTeal = 31
mxlChartLineBlue = 32
' Shape scheme colors
mxlSchemeColorBlack = 8
mxlSchemeColorDarkRed = 16
mxlSchemeColorRed = 10
mxlSchemeColorPink = 14
mxlSchemeColorRose = 45
mxlSchemeColorBrown = 60
mxlSchemeColorOrange = 53
mxlSchemeColorLightOrange = 52
mxlSchemeColorGold = 51
mxlSchemeColorTan = 47
mxlSchemeColorOliveGreen = 59
mxlSchemeColorDarkYellow = 19
mxlSchemeColorLime = 50
mxlSchemeColorYellow = 13
mxlSchemeColorLightYellow = 43
mxlSchemeColorDarkGreen = 58
mxlSchemeColorGreen = 17
mxlSchemeColorSeaGreen = 57
mxlSchemeColorBrightGreen = 11
mxlSchemeColorLightGreen = 42
mxlSchemeColorDarkTeal = 56
mxlSchemeColorTeal = 21
mxlSchemeColorAqua = 49
mxlSchemeColorTurquoise = 15
mxlSchemeColorLightTurquoise = 41
mxlSchemeColorDarkBlue = 18
mxlSchemeColorBlue = 12
mxlSchemeColorLightBlue = 48
mxlSchemeColorSkyBlue = 40
mxlSchemeColorPaleBlue = 44
mxlSchemeColorIndigo = 62
mxlSchemeColorBlueGray = 54
mxlSchemeColorViolet = 20
mxlSchemeColorPlum = 61
mxlSchemeColorLavender = 46
mxlSchemeColorGray80 = 63
mxlSchemeColorGray50 = 23
mxlSchemeColorGray40 = 55
mxlSchemeColorGray25 = 22
mxlSchemeColorWhite = 9
End Enum

Public Sub Marker_AddMarkers( _
ByVal TargetRange As Range, _
ByVal ClickRoutineName As String _
)

' Add markers to the range specified by the parameter TargetRange.

Dim Cell As Range
Dim Marker As Shape

For Each Cell In TargetRange
Cell.Font.ColorIndex = IIf(Cell.Interior.ColorIndex = mxlNoColor,
mxlWhite, Cell.Interior.ColorIndex)
If Len(Cell) = 0 Then Cell = False
Set Marker = TargetRange.Parent.Shapes.AddShape(msoShapeRectang le,
Cell.Left + 2, Cell.Top + 2, Cell.Height - 3.5, Cell.Height - 3.5)
With Marker
.Fill.Solid
.Fill.Transparency = 0
.Line.Weight = 1.5
If Cell.Interior.ColorIndex = mxlGray25 Then
.Line.ForeColor.SchemeColor = mxlSchemeColorGray80
Else
.Line.ForeColor.SchemeColor = mxlSchemeColorGray25
End If
.Fill.ForeColor.SchemeColor = mxlSchemeColorGray50
End With
Marker.OnAction = ClickRoutineName
Next Cell
Marker_SetMarkersInRange TargetRange

End Sub

Public Function Marker_HandleMarkerClick( _
ByVal Marker As Shape _
)

Marker.TopLeftCell = Not Marker.TopLeftCell
Marker.Fill.Visible = IIf(Marker.TopLeftCell, msoTrue, msoFalse)

End Function

Public Sub Marker_SetMarker( _
ByVal Marker As Shape _
)

Marker.Fill.Visible = IIf(Marker.TopLeftCell, msoTrue, msoFalse)

End Sub

Public Sub Marker_SetMarkersInRange( _
ByVal TargetRange As Range _
)

' Set all markers in the range specified by the parameter TargetRange.

Dim Shape As Shape

For Each Shape In TargetRange.Parent.Shapes
If Shape.Type = msoAutoShape Then
If Shape.AutoShapeType = msoShapeRectangle Then
If Not Intersect(TargetRange, Shape.TopLeftCell) Is Nothing Then
Marker_SetMarker Shape
End If
End If
Next Shape

End Sub