Feebly trying to evaluate several fields by VBA

[Gingertrees]

Trying to classify businesses by a number of factors put together. I'd like to do this in a query; number of variable factors leads me to believe some of this needs to be a UDF in VBA. The classification system would be similar to the packages you can buy at a car wash (except pretend you can order each option separately, e.g. wash, undercarriage, but not tire-bright):

Good: wash, hot wax, hot dry
Better: wash, undercarriage flush, tire wash, hot wax, hot dry
Best: wash, undercarriage flush, tire-bright, Premium wax, spot-free rinse, soft-cloth

So the table would be wax (hot/Premium), undercarriage (yes/no), tires (NA/tirewash/tirebright), spotfree (yes/no), dry (hot/softcloth)

I need to figure out how to say
"if wax=premium, undercarriage=yes, tires=tire-bright, spotfree=yes, dry=softcloth, THEN type=BEST
Else if wax=hot OR premium, undercarriage=yes, tires=tirewash OR tire-bright, spotfree=no, dry=hot, THEN type=BETTER
Else if wax=hot OR premium, dry=hot, undercarriage=no, tires=no, spotfree=no, THEN GOOD
Otherwise type = NA"

Option Compare Database

Public Function TypeAchieved() As Variant
Dim rs As DAO.Recordset
Dim db As Database

Set db = CurrentDb

Set rs = db.Recordsets("CarPkgs")

‘pseudocode…
‘If (And(rs!wax=”premium”, rs!undercarriage=”yes”, rs!tires=”tire-bright”, rs!spotfree=”yes”, ‘rs!dry=”softcloth”)) Then TypeAchieved = “Best”
 
‘Else if(And(rs!undercarriage=”yes”, rs!tires/=”NA”,rs!spotfree=”no”)) Then TypeAchieved = “Better”
 
‘Else if(And(rs!wax=”hot”,rs!dry=”hot”)) Then TypeAchieved = “Good”
 
‘Else
‘End if

End Function

 

[Austrada]

Try this and see if TypeAchieved returns the results you are expecting:

'pseudocode…
    If rs!wax = ”premium” And rs!undercarriage = ”yes” And rs!tires = ”tire - bright” And rs!spotfree = ”yes” And rs!dry = ”softcloth” Then TypeAchieved = “Best”
    ElseIf rs!undercarriage = ”yes” And rs!tires = ”NA” And rs!spotfree = ”no” Then TypeAchieved = “Better”
    ElseIf rs!wax = ”hot” And rs!dry = ”hot” Then TypeAchieved = “Good”
    End If

 

[xenou]

It's probably overkill but I will sometimes write my code so as to be more readable (three months from now when I have to go back to it and understand how it works again):

Public Function TypeAchieved() As Variant
Dim rs As DAO.Recordset
Dim x As Long

	Set rs = CurrentDB.Recordsets("CarPkgs")
	
	'//Type BEST
	If TypeAchieved = "" Then
		x = 0
                x = x + IIf(!wax = "premium",1,0)
		x = x + IIf(!undercarriage="yes",1,0)
		x = x + IIf(!tires="tire-bright",1,0)
		x = x + IIf(!spotfree="yes",1, 0)
		x = x + Iif(!dry="softcloth",1,0)
		If x = 5 Then
			TypeAchieved = "Best"
		End If
	End If
	
	'//Type BETTER
	If TypeAchieved = "" Then
		x = 0
		x = x + IIf(!undercarriage="yes",1,0)
		x = x + IIf(!tires="NA",1,0)
		x = x + IIf(!spotfree="no",1,0)
		If x = 3 Then
			TypeAchieved = "Better"
		End If
	End If
	
	'//Type GOOD
	If TypeAchieved = "" Then
		x = 0
		x = x + IIf(!wax="hot",1,0)
		x = x + IIf(!dry="hot",1,0)
		If x = 2 Then
			TypeAchieved = "Good"
		End If
	End If
	
	rs.Close
	Set rs = Nothing

End Function

An advantage is that if you need to add more categories or change existing ones, it's a lot easier to see what to do or to repeat the pattern.

 

[Gingertrees]

Two questions:
1) I'm getting run-time errors on this - 3265 (Item not found in this collection), and if I comment the offending line out, error 91 (object variable or with block variable not set). I already checked spelling on all fields and table name.

 Set rs =  CurrentDb.Recordsets("CarPkgs")   '<== runtime error 3265 here.  CarPkgs is the name of the table in the currentdb.
    If TypeAchieved = "" Then
        x = 0
        x = x + IIf(rs!wax = "premium", 1, 0)   '<== runtime error 91 when Set rs line is commented out

2) What if I wanted to have a "yes" in any one of three factors count towards a classification? So
factor 1 = yes
factor 2 = no
factor 3 = no

would count, as would yes, yes, no; no, yes, no; etc.
This would be in addition to other factors (wax = hot, etc).

 

[xenou]

Sorry, typo. Amend to:
Set rs = CurrentDb.OpenRecordset("CarPkgs")


For more complicated totals you can use a variety of methods (I would make careful comments as this gets confusing even to oneself). Such as:

    [COLOR="SeaGreen"]'//Type GREAT[/COLOR]
    [COLOR="Navy"]If[/COLOR] TypeAchieved = "" [COLOR="Navy"]Then[/COLOR]
        
        x = 0
        x = x + IIf(!wax = "premium", 1, 0)
        x = x + IIf(!undercarriage = "yes", 1, 0)
        x = x + IIf(!tires = "tire-bright", 1, 0)
        x = x + IIf(!spotfree = "yes", 1, 0)
        x = x + IIf(!factor1 = "yes" [COLOR="Navy"]Or[/COLOR] !factor2 = "yes" [COLOR="Navy"]Or[/COLOR] !factor3 = "yes", 1, 0)
        x = x + IIf(!dry = "softcloth", 1, 0)
        [COLOR="Navy"]If[/COLOR] x = 6 [COLOR="Navy"]Then[/COLOR]
            TypeAchieved = "Great"
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

Or, more verbosely:

    [COLOR="SeaGreen"]'//Type GREAT[/COLOR]
    [COLOR="Navy"]If[/COLOR] TypeAchieved = "" [COLOR="Navy"]Then[/COLOR]
        
        x = 0
        x = x + IIf(!wax = "premium", 1, 0)      [COLOR="SeaGreen"]'//Wax[/COLOR]
        x = x + IIf(!undercarriage = "yes", 1, 0) [COLOR="SeaGreen"]'//Undercarriage[/COLOR]
        x = x + IIf(!tires = "tire-bright", 1, 0) [COLOR="SeaGreen"]'//Tires[/COLOR]
        x = x + IIf(!spotfree = "yes", 1, 0)     [COLOR="SeaGreen"]'//Spotfree[/COLOR]
        x = x + IIf(!dry = "softcloth", 1, 0)    [COLOR="SeaGreen"]'//softcloth[/COLOR]

        [COLOR="Navy"]If[/COLOR] !factor1="yes" [COLOR="Navy"]Then[/COLOR]                 [COLOR="SeaGreen"]'//One or more of factor1, factor2, or factor3[/COLOR]
            x = x + 1
        [COLOR="Navy"]ElseIf[/COLOR] !factor2="yes" [COLOR="Navy"]Then[/COLOR]
            x = x + 1
        [COLOR="Navy"]ElseIf[/COLOR] !factor3="yes" [COLOR="Navy"]Then[/COLOR]
            x = x + 1
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

        [COLOR="Navy"]If[/COLOR] x = 6 [COLOR="Navy"]Then[/COLOR]
            TypeAchieved = "Great"
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

I haven't tested these for syntax errors.
ξ

 

[Gingertrees]

So far so good in terms of getting rid of errors - now, how do I use it? I want this function to feed a column in my query. I tried expression builder, but it looks like it wants arguments when I try to put it in expression builder:

 Expr1: TypeAchieved(

but I am confused what to put there. The ID is the primary key throughout the query and table it's based on. But how do I tell it that?
I want it to figure out type for each of the records in this query. So for record ID #1, I want it to tell me the typeachieved for #1, for record #2 I want typeacheived ID #2, etc.
I tried adding Dim ID as String and "With ID"/"End with", so the argument could be =TypeAchieved(ID), but that was "not enough arguments." What the heck???

 

[xenou]

It's a little awkward as a function with so many fields involved. If you can run it as a batch process then you can update the fields in the table on an as needed basis (such as when you are going to need a report on the results).

I.e., like this as SUB in a standard module (this is also untested - I've been in the habit of writing code in a text editor lately). Note how on each loop we update the value of the field you want to have the result in.

[COLOR="Navy"]Public[/COLOR] [COLOR="Navy"]Sub[/COLOR] TypeAchieved()
[COLOR="Navy"]Dim[/COLOR] rs [COLOR="Navy"]As[/COLOR] DAO.Recordset
[COLOR="Navy"]Dim[/COLOR] x [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

    [COLOR="Navy"]Set[/COLOR] rs = CurrentDB.OpenRecordset("CarPkgs")
    [COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] [COLOR="Navy"]Not[/COLOR] rs.EOF
        [COLOR="Navy"]With[/COLOR] rs

            TypeAchieved = "" [COLOR="SeaGreen"]'//Prime Test Variable[/COLOR]
            
            [COLOR="SeaGreen"]'//Type BEST[/COLOR]
            [COLOR="Navy"]If[/COLOR] TypeAchieved = "" [COLOR="Navy"]Then[/COLOR]
                x = 0
                        x = x + IIf(!wax = "premium", 1, 0)
                x = x + IIf(!undercarriage = "yes", 1, 0)
                x = x + IIf(!tires = "tire-bright", 1, 0)
                x = x + IIf(!spotfree = "yes", 1, 0)
                x = x + IIf(!dry = "softcloth", 1, 0)
                [COLOR="Navy"]If[/COLOR] x = 5 [COLOR="Navy"]Then[/COLOR]
                    TypeAchieved = "Best"
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            
            [COLOR="SeaGreen"]'//Type BETTER[/COLOR]
            [COLOR="Navy"]If[/COLOR] TypeAchieved = "" [COLOR="Navy"]Then[/COLOR]
                x = 0
                x = x + IIf(!undercarriage = "yes", 1, 0)
                x = x + IIf(!tires = "NA", 1, 0)
                x = x + IIf(!spotfree = "no", 1, 0)
                [COLOR="Navy"]If[/COLOR] x = 3 [COLOR="Navy"]Then[/COLOR]
                    TypeAchieved = "Better"
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            
            [COLOR="SeaGreen"]'//Type GOOD[/COLOR]
            [COLOR="Navy"]If[/COLOR] TypeAchieved = "" [COLOR="Navy"]Then[/COLOR]
                x = 0
                x = x + IIf(!wax = "hot", 1, 0)
                x = x + IIf(!dry = "hot", 1, 0)
                [COLOR="Navy"]If[/COLOR] x = 2 [COLOR="Navy"]Then[/COLOR]
                    TypeAchieved = "Good"
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

            !SomeField.Value = IIf(TypeAchieved <> "", TypeAchieved, Null)
            .MoveNext
    
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]

    [COLOR="Navy"]Loop[/COLOR]

    rs.Close
    [COLOR="Navy"]Set[/COLOR] rs = [COLOR="Navy"]Nothing[/COLOR]

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

 

[Gingertrees]

Oh crud. I picked "function" because I sort of know how to use those. Batch processing? That's a whole different animal (and one that I know nothing about). From a few minutes of Googling, it looks like far higher levels of programming than I'm comfortable with.

Any way to do this that won't involve a several-work-day learning curve? I understand that batch might be the most efficient way to do it, but if there's a way to shoehorn something into a query, I'd be just as happy with that. Thoughts???

 

[xenou]

I'm not really sure. Don't be put off by the term batch processing. It just means running a procedure to update the field in the table - you just run it as a preparatory step. Then you go on your merry way. I'm not sure how I'd do this otherwise. This requires so many fields to look at that a function would require all the other fields as parameters:

TypeAchieved(undercarriage, spotfree, wax, tires, dry) As String
'//blah blah
End Function

That's possible if you want to go that route (a little ugly but vastly better than one massive IIF function).


Edit: more specifically something like (you would probably want to be prepared to get a zero-length string in return if the code didn't find a match or if one of the arguments were missing or invalid. I can't really vouch for this but it is an example:

Public Function TypeAchieved(Optional wax As String, Optional undercarriage As String, _
	Optional tires As String, Optional spotfree As String, Optional dry As String) As String
Dim x As Long

            On Error Resume Next

            '//Type BEST
            If TypeAchieved = "" Then
                x = 0
                x = x + IIf(wax = "premium", 1, 0)
                x = x + IIf(undercarriage = "yes", 1, 0)
                x = x + IIf(tires = "tire-bright", 1, 0)
                x = x + IIf(spotfree = "yes", 1, 0)
                x = x + IIf(dry = "softcloth", 1, 0)
                If x = 5 Then
                    TypeAchieved = "Best"
                End If
            End If
            
            '//Type BETTER
            If TypeAchieved = "" Then
                x = 0
                x = x + IIf(undercarriage = "yes", 1, 0)
                x = x + IIf(tires = "NA", 1, 0)
                x = x + IIf(spotfree = "no", 1, 0)
                If x = 3 Then
                    TypeAchieved = "Better"
                End If
            End If
            
            '//Type GOOD
            If TypeAchieved = "" Then
                x = 0
                x = x + IIf(wax = "hot", 1, 0)
                x = x + IIf(dry = "hot", 1, 0)
                If x = 2 Then
                    TypeAchieved = "Good"
                End If
            End If
End Sub

 

[Gingertrees]

Don't be put off by the term batch processing. It just means running a procedure to update the field in the table - you just run it as a preparatory step.

Alright, maybe I assumed too much. What Google showed me was lots of writing lengthy code, running from command prompt, etc.
So you're saying I could just move the function code into a Sub, and just choose to run that when I wanted to determine Type Achieved? I don't mind doing that so much.

Also, can I get this Sub to update an otherwise empty field in a query? I have to do reports regularly classifying types, so it'd be good if I could get this into an easily exportable format. Or do I just incorporate that into the sub - to basically have the sub act as a MakeTable query?

#new territory