Condensing several similar macros to 1 (if possible)

[Bruce54]

I have 8 macro buttons that simply change the value of one cell - [D13] to States ("NSW","QLD" ...)
When this happens (ignoring the other functions) the button text turns white (from Black)

all relevant code:
'------------------------------------------------------------------'
'Sub PCODES_Rectangle3_Click()
'ClearButtons
' If Not [D13] = " (NSW)" Then
' ActiveSheet.Shapes.Range(Array("Rectangle 3")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' [D13] = " (NSW)"
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub Rectangle7_Click()
'ClearButtons
' If Not [D13] = " (QLD)" Then
' [D13] = " (QLD)"
' ActiveSheet.Shapes.Range(Array("Rectangle 7")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub Rectangle8_Click()
'ClearButtons
' If Not [D13] = " (VIC)" Then
' [D13] = " (VIC)"
' ActiveSheet.Shapes.Range(Array("Rectangle 8")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub Rectangle10_Click()
'ClearButtons
' If Not [D13] = " (SA)" Then
' [D13] = " (SA)"
' ActiveSheet.Shapes.Range(Array("Rectangle 10")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub Rectangle11_Click()
'ClearButtons
' If Not [D13] = " (NT)" Then
' [D13] = " (NT)"
' ActiveSheet.Shapes.Range(Array("Rectangle 11")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub Rectangle12_Click()
'ClearButtons
' If Not [D13] = " (WA)" Then
' [D13] = " (WA)"
' ActiveSheet.Shapes.Range(Array("Rectangle 12")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub Rectangle13_Click()
'ClearButtons
' If Not [D13] = " (TAS)" Then
' [D13] = " (TAS)"
' ActiveSheet.Shapes.Range(Array("Rectangle 13")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub Rectangle14_Click()
'ClearButtons
' If Not [D13] = " (ACT)" Then
' [D13] = " (ACT)"
' ActiveSheet.Shapes.Range(Array("Rectangle 14")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorBackground1
' End With
' Else
' ClearButtons
' End If
'[B13].Activate
'End Sub
'
'Sub ClearButtons()
'[D13] = ""
' ActiveSheet.Shapes.Range(Array("Group 15")).Select
' With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
' .ForeColor.ObjectThemeColor = msoThemeColorText1
' End With
'End Sub
'-----------------------------------------------------------'

I know this is simple stuff, but I'm a beginner, so any help would be appreciated

 

[ParamRay]

Hello, it will be along these lines:

Private Sub Rectangle_Click(strMatchText As String, strRectangle As String)
  If Me.Range("D13").Value <> strMatchText Then
    Me.Shapes(strRectangle).TextFrame2.TextRange.Font.Fill.ForeColor = msoThemeColorBackground1
    Me.Range("D13").Value = strMatchText
  Else
    Call ClearButtons
  End If
End Sub

Sub Rectangle7_Click()
  Call Rectangle_Click(" (QLD)", "Rectangle 7")
End Sub

Sub Rectangle8_Click()
  Call Rectangle_Click(" (VIC)", "Rectangle 8")
End Sub

' And so on...