Cell value combination question

[epactheactor]

Hello!

I'm working on a code and have come upon something that I hope has an easy way to do.

In it, there are 3 cells in the workbook. Each cell can only have 1 of 3 possible string values in it. For this example say A, B or C. Depending on the combination of letter, they receive a different score.

Is there a way to write out a code without having to write out every possible combination? I would think maybe a select case, but I would still have to write out every possible combination, correct?



For example in puedocode,

If ((Cell1 = "A" Cell2 = "B" Cell3 = "C") or (Cell1 = "B" Cell2 = "A" Cell3 = "C") or (Cell1 = "C" Cell2 = "B" Cell3 = "A") (and so on) )
score = 100
Elseif (Cell1 = "A" Cell2 = "A" Cell3 = "C") or (Cell1 = "A" Cell2 = "C" Cell3 = "C")
score = 50
ElseIf (Cell1 = "B" Cell2 = "B" Cell3 = "C"
score = 60.
(And so on)

Thank you for any help.

 

[MickG]

This UDF should work, you will need to add more "Instr's". to run the UDF enter data as :- =olet("ABC")
Save Code to Basic Module:-

NB:- Run second code first to see in columns "D & E" the combinations you are catering for.

Function oLets(nStr [COLOR="Navy"]As[/COLOR] String) [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n, nn, nnn, c, osum [COLOR="Navy"]As[/COLOR] Double, nRay() [COLOR="Navy"]As[/COLOR] Variant

Ray = Array("A", "B", "C")
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(Ray)
    [COLOR="Navy"]For[/COLOR] nn = 0 To UBound(Ray)
        [COLOR="Navy"]For[/COLOR] nnn = 0 To UBound(Ray)
            ReDim Preserve nRay(c)
            nRay(c) = Ray(n) & Ray(nn) & Ray(nnn)
             c = c + 1
        [COLOR="Navy"]Next[/COLOR] nnn
    [COLOR="Navy"]Next[/COLOR] nn
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(nRay)
    osum = 0
    [COLOR="Navy"]If[/COLOR] InStr(nRay(n), "A") > 0 And InStr(nRay(n), "B") > 0 And InStr(nRay(n), "C") > 0 [COLOR="Navy"]Then[/COLOR]
        osum = 100
    [COLOR="Navy"]ElseIf[/COLOR] InStr(nRay(n), "A") > 0 And InStr(nRay(n), "B") > 0 [COLOR="Navy"]Then[/COLOR]
        osum = 50
    [COLOR="Navy"]ElseIf[/COLOR] InStr(nRay(n), "B") > 0 And InStr(nRay(n), "C") > 0 [COLOR="Navy"]Then[/COLOR]
        osum = 60
    [COLOR="Navy"]End[/COLOR] If
    .Add nRay(n), osum
[COLOR="Navy"]Next[/COLOR]
oLets = .Item(nStr)
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] Function

'Second Code:-

[COLOR="Navy"]Sub[/COLOR] MG29Jul58
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n, nn, nnn, c, osum [COLOR="Navy"]As[/COLOR] Double, nRay() [COLOR="Navy"]As[/COLOR] Variant
 Ray = Array("A", "B", "C")
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(Ray)
    [COLOR="Navy"]For[/COLOR] nn = 0 To UBound(Ray)
        [COLOR="Navy"]For[/COLOR] nnn = 0 To UBound(Ray)
            ReDim Preserve nRay(c)
             nRay(c) = Ray(n) & Ray(nn) & Ray(nnn)
        c = c + 1
        [COLOR="Navy"]Next[/COLOR] nnn
    [COLOR="Navy"]Next[/COLOR] nn
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(nRay)
    osum = 0
    [COLOR="Navy"]If[/COLOR] InStr(nRay(n), "A") > 0 And InStr(nRay(n), "B") > 0 And InStr(nRay(n), "C") > 0 [COLOR="Navy"]Then[/COLOR]
        osum = 100
    [COLOR="Navy"]ElseIf[/COLOR] InStr(nRay(n), "A") > 0 And InStr(nRay(n), "B") > 0 [COLOR="Navy"]Then[/COLOR]
        osum = 50
    [COLOR="Navy"]ElseIf[/COLOR] InStr(nRay(n), "B") > 0 And InStr(nRay(n), "C") > 0 [COLOR="Navy"]Then[/COLOR]
        osum = 60
    [COLOR="Navy"]End[/COLOR] If
.Add nRay(n), osum
[COLOR="Navy"]Next[/COLOR]
Range("D1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] With

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

Regards Mick

 

[Special-K99]

What does this mean?
AND or OR

(Cell1 = "A" Cell2 = "A" Cell3 = "C")

 

[epactheactor]

Thanks Mick!

I have no clue why I didn't think to use arrays. It never even entered my mind as inconceivable as that seems.

 

[Eric W]

Is there some rule to decide what the score should be, other than a given combination equals a given score? For example, if an A is worth 50 points no matter where it is, and a B = 75 point, and a C = 88 points, then try:

    str1 = Range("A1").Value & Range("B1").Value & Range("C1").Value
    
    score = (Len(str1) - Len(Replace(str1, "A", ""))) * 50 + _
            (Len(str1) - Len(Replace(str1, "B", ""))) * 75 + _
            (Len(str1) - Len(Replace(str1, "C", ""))) * 88

or

    Points = Array(50, 75, 88)    
    score = Points(Asc([A1]) - Asc("A")) + Points(Asc([B1]) - Asc("A")) + Points(Asc([C1]) - Asc("A"))

Depending on how your scores are derived, it's likely that you can come up with more efficient code than enumerating all possibilities.

 

[Peter_SSs]

If there are just 3 choices per cell then by my reckoning, if we ignore the order, then there are only 10 combinations.

All letters different: 1 combination
ABC

2 of one letter and 1 of another letter: 6 combinations
AAB
AAC
ABB
ACC
BBC
BCC

All letters the same: 3 combinations
AAA
BBB
CCC

So I think if we put each string combination in alphabetical order as above and used Select Case it shouldn't be too bad, particularly as it appears some combinations result in the same score (AAC and ACC both give 50 per your example)

Then perhaps this UDF, once completed, might do? Or have I misinterpreted the problem?

Function Score(rng As Range) As Long
  Dim AL As Object
  Dim r As Range
  
  Set AL = CreateObject("System.Collections.ArrayList")
  For Each r In rng
    AL.Add r.Value
  Next r
  AL.Sort
  Select Case Join(AL.ToArray, "")
    Case "ABC": Score = 100
    Case "AAC", "ACC": Score = 50
    Case "BBC": Score = 60
    
    ' Cases for the other 6 alphabetical order combinations here
    
  End Select
End Function

Excel Workbook
	A	B	C	D
1	A	C	B	100
2	C	A	C	50
3	B	C	B	60
Sheet2

 

[MickG]

You're welcome