# Calculating a Score in VBA based on selected ShapeStyle. Is there a better/shorter way to do this?

I'm calculating a score based on whether or not certain colors shape is selected. Some of the shapes are in groups, some are not. For the shapes which are in groups, only one of them will count towards the score. I have figured out how, as you can see below. However, I have 9 more shapes/scores to add to the Sub. I'm still somewhat new at VBA, and I am wondering if there is a better/shorter way to write this formula. Thanks in advance.

Sub Lead_Score()
With Sheet1

Dim Cust As Integer, Vend As Integer, Sus As Integer, Pros As Integer, RelScore As Integer, Qual As Integer, NonQual As Integer, QualScore As Integer, Score As Integer
Cust = .Shapes("CustomerButton").ShapeStyle
Vend = .Shapes("VendorButton").ShapeStyle
Sus = .Shapes("SuspectButton").ShapeStyle
Pros = .Shapes("ProspectButton").ShapeStyle
Qual = .Shapes("QualifiedButton").ShapeStyle
NonQual = .Shapes("NonQualifiedButton").ShapeStyle

Dim Customer As Long, Vendor As Long, Prospect As Long, Suspect As Long, Qfied As Long, NQfied As Long
Customer = 0
Vendor = 0
Prospect = 15
Suspect = 5
Qfied = 15
NQfied = 0

If Cust = 34 Then
RelScore = Customer
End If
If Vend = 34 Then
RelScore = Vendor
End If
If Sus = 34 Then
RelScore = Suspect
End If
If Pros = 34 Then
RelScore = Prospect
End If
If Qual = 34 Then
QualScore = Qfied
End If
If NonQual = 34 Then
QualScore = NQfied
End If

Score = RelScore + QualScore
Debug.Print Score

End With
End Sub


You deleted this before I could answer on SO:

Option Explicit

Dim shp As Shape
Dim RelScore As Long
Dim QualScore As Long
For Each shp In ThisWorkbook.Sheets(1).Shapes 'change (1) for your sheet name.
RelScore = MyRelScore(shp)
QualScore = MyQualScore(shp)
Next shp
Dim Score As Long
Score = RelScore + QualScore
Debug.Print Score

End Sub
Private Function MyRelScore(shp As Shape) As Long

Select Case shp.Name
Case "CustomerButton", "VendorButton"
If shp.ShapeStyle = 34 Then MyRelScore = 0
Case "ProspectButton"
If shp.ShapeStyle = 34 Then MyRelScore = 15
'Case ...
End Select

End Function
Private Function MyQualScore(shp As Shape) As Long

Select Case shp.Name
Case "SuspectButton"
If shp.ShapeStyle = 34 Then MyQualScore = 5
Case "QualifiedButton"
If shp.ShapeStyle = 34 Then MyQualScore = 15
Case "NonQualifiedButton"
If shp.ShapeStyle = 34 Then MyQualScore = 0
'Case ...
End Select

End Function