1
\$\begingroup\$

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
\$\endgroup\$
3
\$\begingroup\$

You deleted this before I could answer on SO:

Option Explicit
Sub Lead_Score()

    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
\$\endgroup\$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.