making macro shorter/easier

[dedjloco]

Is there a way to make the macro below shorter or leaner?

Public Sub ScoreMacro()
Dim Score As Single
Dim Counter As Single
Dim Total As Single
Dim ProductWeeg As Single
Dim DriveWeeg As Single
Dim SWLWeeg As Single
Dim BoomWeeg As Single
Dim BridgeWeeg As Single
Dim NrWeeg As Single
Dim NormWeeg As Single
Dim CAWeeg As Single
Dim FeaturesWeeg As Single
Dim RelationWeeg As Single
Dim CompetitorsWeeg As Single
Dim ClientWeeg As Single
Dim MarketWeeg As Single
Dim UserWeeg As Single
Dim TendertimeWeeg As Single
Dim EstValueWeeg As Single

ProductWeeg = Forms("Scores").ScoreProductWeeg_Text.Value
DriveWeeg = Forms("Scores").ScoreDriveWeeg_Text.Value
SWLWeeg = Forms("Scores").ScoreSWLWeeg_Text.Value
BoomWeeg = Forms("Scores").ScoreBoomWeeg_Text.Value
BridgeWeeg = Forms("Scores").ScoreBridgeWeeg_Text.Value
NrWeeg = Forms("Scores").ScoreNrWeeg_Text.Value
NormWeeg = Forms("Scores").ScoreNormWeeg_Text.Value
CAWeeg = Forms("Scores").ScoreCAWeeg_Text.Value
FeaturesWeeg = Forms("Scores").ScoreFeaturesWeeg_Text.Value
RelationWeeg = Forms("Scores").ScoreRelationWeeg_Text.Value
CompetitorsWeeg = Forms("Scores").ScoreCompetitorsWeeg_Text.Value
ClientWeeg = Forms("Scores").ScoreClientWeeg_Text.Value
MarketWeeg = Forms("Scores").ScoreMarketWeeg_Text.Value
UserWeeg = Forms("Scores").ScoreUserWeeg_Text.Value
TendertimeWeeg = Forms("Scores").ScoreTendertimeWeeg_Text.Value
EstValueWeeg = Forms("Scores").ScoreEstValueWeeg_Text.Value
Score = 0
Counter = 0
Total = 0
'Product type
If Me.BH_Check = True Then
    Score = Score + (Forms("Scores").ScoreProductBH_Text.Value * ProductWeeg)
    Counter = Counter + ProductWeeg
End If
If Me.GW_Check = True Then
    Score = Score + (Forms("Scores").ScoreProductGW_Text.Value * ProductWeeg)
    Counter = Counter + ProductWeeg
End If
If Me.KB_Check = True Then
    Score = Score + (Forms("Scores").ScoreProductKB_Text.Value * ProductWeeg)
    Counter = Counter + ProductWeeg
End If
If Me.RL_Check = True Then
    Score = Score + (Forms("Scores").ScoreProductRL_Text.Value * ProductWeeg)
    Counter = Counter + ProductWeeg
End If
If Me.Other_Check = True Then
    Score = Score + (Forms("Scores").ScoreProductOther_Text.Value * ProductWeeg)
    Counter = Counter + ProductWeeg
End If
'Drive type
If Me.DHC_Check = True Then
    Score = Score + (Forms("Scores").ScoreDriveDHC_Text.Value * DriveWeeg)
    Counter = Counter + DriveWeeg
End If
If Me.EHC_Check = True Then
    Score = Score + (Forms("Scores").ScoreDriveEHC_Text.Value * DriveWeeg)
    Counter = Counter + DriveWeeg
End If
If Me.EC_Check = True Then
    Score = Score + (Forms("Scores").ScoreDriveEC_Text.Value * DriveWeeg)
    Counter = Counter + DriveWeeg
End If
If Me.NotSpecified_Check = True Then
    Score = Score + (Forms("Scores").ScoreDriveNotspecified_Text.Value * DriveWeeg)
    Counter = Counter + DriveWeeg
End If
If Me.Open_Check = True Then
    Score = Score + (Forms("Scores").ScoreDriveOpen_Text.Value * DriveWeeg)
    Counter = Counter + DriveWeeg
End If
'SWL
If Me.SWL_Text > 0 And Me.SWL_Text < 5 Then
    Score = Score + (Forms("Scores").ScoreSWL1_Text.Value * SWLWeeg)
    Counter = Counter + SWLWeeg
End If
If Me.SWL_Text >= 5 And Me.SWL_Text < 20 Then
    Score = Score + (Forms("Scores").ScoreSWL2_Text.Value * SWLWeeg)
    Counter = Counter + SWLWeeg
End If
If Me.SWL_Text >= 20 And Me.SWL_Text < 50 Then
    Score = Score + (Forms("Scores").ScoreSWL3_Text.Value * SWLWeeg)
    Counter = Counter + SWLWeeg
End If
If Me.SWL_Text >= 50 And Me.SWL_Text < 200 Then
    Score = Score + (Forms("Scores").ScoreSWL4_Text.Value * SWLWeeg)
    Counter = Counter + SWLWeeg
End If
If Me.SWL_Text >= 200 And Me.SWL_Text < 1000 Then
    Score = Score + (Forms("Scores").ScoreSWL5_Text.Value * SWLWeeg)
    Counter = Counter + SWLWeeg
End If
If Me.SWL_Text >= 1000 Then
    Score = Score + (Forms("Scores").ScoreSWL6_Text.Value * SWLWeeg)
    Counter = Counter + SWLWeeg
End If
'Boom Lenght
If Me.Boom_Text >= 10 And Me.Boom_Text < 50 Then
    Score = Score + (Forms("Scores").ScoreBoom1_Text.Value * BoomWeeg)
    Counter = Counter + Forms("Scores").ScoreBoomWeeg_Text.Value
End If
If Me.Boom_Text >= 50 And Me.Boom_Text < 100 Then
    Score = Score + (Forms("Scores").ScoreBoom2_Text.Value * BoomWeeg)
    Counter = Counter + Forms("Scores").ScoreBoomWeeg_Text.Value
End If
If Me.Boom_Text >= 100 Then
    Score = Score + (Forms("Scores").ScoreBoom3_Text.Value * BoomWeeg)
    Counter = Counter + BoomWeeg
End If
'Bridge Lenght
If Me.Bridge_Text >= 5 And Me.Bridge_Text < 20 Then
    Score = Score + (Forms("Scores").ScoreBridge1_Text.Value * BridgeWeeg)
    Counter = Counter + BridgeWeeg
End If
If Me.Bridge_Text >= 20 And Me.Bridge_Text < 50 Then
    Score = Score + (Forms("Scores").ScoreBoom2_Text.Value * BridgeWeeg)
    Counter = Counter + BridgeWeeg
End If
If Me.Bridge_Text >= 50 Then
    Score = Score + (Forms("Scores").ScoreBridge3_Text.Value * BridgeWeeg)
    Counter = Counter + BridgeWeeg
End If
'Nr. of Products
If Me.NrofProducts_Text = 1 Then
    Score = Score + (Forms("Scores").ScoreNr1_Text.Value * NrWeeg)
    Counter = Counter + NrWeeg
End If
If Me.NrofProducts_Text = 2 Then
    Score = Score + (Forms("Scores").ScoreNr2_Text.Value * NrWeeg)
    Counter = Counter + NrWeeg
End If
If Me.NrofProducts_Text = 3 Then
    Score = Score + (Forms("Scores").ScoreNr3_Text.Value * NrWeeg)
    Counter = Counter + NrWeeg
End If
If Me.NrofProducts_Text >= 4 Then
    Score = Score + (Forms("Scores").ScoreNr4_Text.Value * NrWeeg)
    Counter = Counter + NrWeeg
End If
'Norm
If Me.EN_Check = True Then
    Score = Score + (Forms("Scores").ScoreNormEN_Text.Value * NormWeeg)
    Counter = Counter + NormWeeg
End If
If Me.API_Check = True Then
    Score = Score + (Forms("Scores").ScoreNormAPI_Text.Value * NormWeeg)
    Counter = Counter + NormWeeg
End If
If Me.Norsok_Check = True Then
    Score = Score + (Forms("Scores").ScoreNormNorsok_Text.Value * NormWeeg)
    Counter = Counter + NormWeeg
End If
If Me.CARules_Check = True Then
    Score = Score + (Forms("Scores").ScoreNormCARules_Text.Value * NormWeeg)
    Counter = Counter + NormWeeg
End If
'CA
If Me.LRS_Check = True Then
    Score = Score + (Forms("Scores").ScoreCALRS_Text.Value * CAWeeg)
    Counter = Counter + CAWeeg
End If
If Me.DNV_Check = True Then
    Score = Score + (Forms("Scores").ScoreCADNV_Text.Value * CAWeeg)
    Counter = Counter + CAWeeg
End If
If Me.ABS_Check = True Then
    Score = Score + (Forms("Scores").ScoreCAABS_Text.Value * CAWeeg)
    Counter = Counter + CAWeeg
End If
If Me.BV_Check = True Then
    Score = Score + (Forms("Scores").ScoreCABV_Text.Value * CAWeeg)
    Counter = Counter + CAWeeg
End If
'Features
If Me.AMC_Check = True Then
    Score = Score + (Forms("Scores").ScoreFeaturesAMC_Text.Value * FeaturesWeeg)
    Counter = Counter + FeaturesWeeg
End If
If Me.AHC_Check = True Then
    Score = Score + (Forms("Scores").ScoreFeaturesAHC_Text.Value * FeaturesWeeg)
    Counter = Counter + FeaturesWeeg
End If
If Me.Telescopic_Check = True Then
    Score = Score + (Forms("Scores").ScoreFeaturesTelescopic_Text.Value * FeaturesWeeg)
    Counter = Counter + FeaturesWeeg
End If
If Me.Manriding_Check = True Then
    Score = Score + (Forms("Scores").ScoreFeaturesManriding_Text.Value * FeaturesWeeg)
    Counter = Counter + FeaturesWeeg
End If
'Relation
If Me.Existing_Check = True Then
    Score = Score + (Forms("Scores").ScoreRelationExisting_Text.Value * RelationWeeg)
    Counter = Counter + RelationWeeg
End If
If Me.New_Check = True Then
    Score = Score + (Forms("Scores").ScoreRelationNew_Text.Value * RelationWeeg)
    Counter = Counter + RelationWeeg
End If
'Competitors
If Me.None_Check = True Then
    Score = Score + (Forms("Scores").ScoreCompetitorsNone_Text.Value * CompetitorsWeeg)
    Counter = Counter + CompetitorsWeeg
End If
If Me.Nr_Text = 1 Then
    Score = Score + (Forms("Scores").ScoreCompetitors1_Text.Value * CompetitorsWeeg)
    Counter = Counter + CompetitorsWeeg
End If
If Me.Nr_Text = 2 Then
    Score = Score + (Forms("Scores").ScoreCompetitors2_Text.Value * CompetitorsWeeg)
    Counter = Counter + CompetitorsWeeg
End If
If Me.Nr_Text >= 3 Then
    Score = Score + (Forms("Scores").ScoreCompetitors3_Text.Value * CompetitorsWeeg)
    Counter = Counter + CompetitorsWeeg
End If
'Client type
If Me.ClientOperator_Check = True Then
    Score = Score + (Forms("Scores").ScoreClientOperator_Text.Value * ClientWeeg)
    Counter = Counter + ClientWeeg
End If
If Me.ClientVessel_Check = True Then
    Score = Score + (Forms("Scores").ScoreClientVessel_Text.Value * ClientWeeg)
    Counter = Counter + ClientWeeg
End If
If Me.ClientContractor_Check = True Then
    Score = Score + (Forms("Scores").ScoreClientContractor_Text.Value * ClientWeeg)
    Counter = Counter + ClientWeeg
End If
If Me.ClientYard_Check = True Then
    Score = Score + (Forms("Scores").ScoreClientYard_Text.Value * ClientWeeg)
    Counter = Counter + ClientWeeg
End If
If Me.ClientConsultant_Check = True Then
    Score = Score + (Forms("Scores").ScoreClientConsultant_Text.Value * ClientWeeg)
    Counter = Counter + ClientWeeg
End If
If Me.ClientFirm_Check = True Then
    Score = Score + (Forms("Scores").ScoreClientFirm_Text.Value * ClientWeeg)
    Counter = Counter + ClientWeeg
End If
'Market
If Me.MarketReplacement_Check = True Then
    Score = Score + (Forms("Scores").ScoreMarketReplacement_Text.Value * MarketWeeg)
    Counter = Counter + MarketWeeg
End If
If Me.MarketVesselOG_Check = True Then
    Score = Score + (Forms("Scores").ScoreMarketVesselOG_Text.Value * MarketWeeg)
    Counter = Counter + MarketWeeg
End If
If Me.MarketVesselWind_Check = True Then
    Score = Score + (Forms("Scores").ScoreMarketVesselWind_Text.Value * MarketWeeg)
    Counter = Counter + MarketWeeg
End If
If Me.MarketVessel1_Check = True Then
    Score = Score + (Forms("Scores").ScoreMarketVessel1_Text.Value * MarketWeeg)
    Counter = Counter + MarketWeeg
End If
If Me.MarketBarge_Check = True Then
    Score = Score + (Forms("Scores").ScoreMarketBarge_Text.Value * MarketWeeg)
    Counter = Counter + MarketWeeg
End If
If Me.MarketFPSO_Check = True Then
    Score = Score + (Forms("Scores").ScoreMarketFPSO_Text.Value * MarketWeeg)
    Counter = Counter + MarketWeeg
End If
If Me.MarketNew_Check = True Then
    Score = Score + (Forms("Scores").ScoreMarketNew_Text.Value * MarketWeeg)
    Counter = Counter + MarketWeeg
End If
'End User
If Me.UserOperator_Check = True Then
    Score = Score + (Forms("Scores").ScoreUserOperator_Text.Value * UserWeeg)
    Counter = Counter + UserWeeg
End If
If Me.UserVessel_Check = True Then
    Score = Score + (Forms("Scores").ScoreUserVessel_Text.Value * UserWeeg)
    Counter = Counter + UserWeeg
End If
If Me.UserContractor_Check = True Then
    Score = Score + (Forms("Scores").ScoreUserContractor_Text.Value * UserWeeg)
    Counter = Counter + UserWeeg
End If
'Tender Time
If Me.TenderTime_Text = 1 Then
    Score = Score + (Forms("Scores").ScoreTendertime1_Text.Value * TendertimeWeeg)
    Counter = Counter + TendertimeWeeg
End If
If Me.TenderTime_Text = 2 Then
    Score = Score + (Forms("Scores").ScoreTendertime2_Text.Value * TendertimeWeeg)
    Counter = Counter + TendertimeWeeg
End If
If Me.TenderTime_Text = 3 Then
    Score = Score + (Forms("Scores").ScoreTendertime3_Text.Value * TendertimeWeeg)
    Counter = Counter + TendertimeWeeg
End If
If Me.TenderTime_Text >= 4 And Me.TenderTime_Text < 7 Then
    Score = Score + (Forms("Scores").ScoreTendertime4_Text.Value * TendertimeWeeg)
    Counter = Counter + TendertimeWeeg
End If
If Me.TenderTime_Text >= 7 And Me.TenderTime_Text < 10 Then
    Score = Score + (Forms("Scores").ScoreTendertime5_Text.Value * TendertimeWeeg)
    Counter = Counter + TendertimeWeeg
End If
If Me.TenderTime_Text >= 10 And Me.TenderTime_Text < 20 Then
    Score = Score + (Forms("Scores").ScoreTendertime6_Text.Value * TendertimeWeeg)
    Counter = Counter + TendertimeWeeg
End If
If Me.TenderTime_Text >= 20 Then
    Score = Score + (Forms("Scores").ScoreTendertime7_Text.Value * TendertimeWeeg)
    Counter = Counter + TendertimeWeeg
End If
'Est. Value
If Me.EstValue_Text > 0 And Me.EstValue_Text < 1000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue1_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 1000000 And Me.EstValue_Text < 3000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 3000000 And Me.EstValue_Text < 5000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 5000000 And Me.EstValue_Text < 8000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 8000000 And Me.EstValue_Text < 11000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 11000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
'To always have a counter of 1 for calculating the score
If Counter = 0 Then
Counter = Counter + 1
End If
Total = Score / Counter
Total = Round(Total, 1)
If Total > 10 Then
    Total = 10
End If

Me.Score_Text.Value = Total
End Sub

 

[Minty]

Yes you can simplify this - have a search on here for looping through form controls.

You can loop around controls of a certain type and/or with a certain attribute. You can add a tag to a control and only apply code to those controls with that tag.

 

[dedjloco]

I've looked it up. But I can only find it for editing the controls it self. My code is a calculation. For each check there is a value and when you check tis box you add this value to the total and then divide it by the number of checked boxes.
And if you put it in an "for each" can you save it to a total each time you loop trough it?

BTW
I have a lot of click events can these be combined in 1 sub? I found something with handles but this doesn't seem to work in office vba.

 

[Minty]

I'm sure this can be handled by a number of loops. Is this code being run from the form "Scores"?
Also this code;

If Me.EstValue_Text > 0 And Me.EstValue_Text < 1000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue1_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 1000000 And Me.EstValue_Text < 3000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 3000000 And Me.EstValue_Text < 5000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 5000000 And Me.EstValue_Text < 8000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 8000000 And Me.EstValue_Text < 11000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If
If Me.EstValue_Text >= 11000000 Then
    Score = Score + (Forms("Scores").ScoreEstValue2_Text.Value * EstValueWeeg)
    Counter = Counter + EstValueWeeg
End If

After the first check (<100000 ) the rest of them are all achieving exactly the same thing?
It would be neater with a Select Case statement as well.

 

[dedjloco]

No it is run from an other form.
Thank you, because you just pointed out a fault in my code. every line should refence to an other "ScoreEstValue". so 1, 2, 3 etc.
So is this still possible with a select case statement? And how do you account for when the value is exactly 1, in my code it is done by the equel sign but if you put this in an case statement you will have the possebility that to statements are true.

 

[Minty]

In a case statement only the first true statement is acted on, or the else clause is used if nothing is true.

I think you could use cleverly named controls and tags to loop around your form and reduce the code (You could refer to the values to be updated, as part of the control names if they were all named in the same format for instance), it really depends on how much time you want to spend on refining it, learning by trying different techniques.

You can also probably neaten the code up by making the form name a constant.