How to automatically assign a value to a cell based on the colour of another.

[MJ72]

Hello all!
Hopefully you can help with this. I am working on a form that needs to be interactive for the user. It has three columns of possible answers to certain questions. So far I have been able to code the form to highlight in yellow (ColorIndex=6) the selected answer based on a double click to highlight and right click to remove highlight.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = 6
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Interior.ColorIndex = 0
End Sub

What I need to do now is assign a point value to the answers so that the points can be tallied in a fourth column.

For example if the answers in column A, B, C are worth 5pts, 3pts and 1pt respectively then when either A,B and/or C is highlighted, the total value in column D would be "5" or "3" or "1" or if all three are selected then the point total in column D would obviously be "9".

I've gotten this far by using columns over to the right (columns AC,AD,AE) in my work sheet:

=IF(ColorIndex($A$1)=6,"5","0")
=IF(ColorIndex($A$2)=6,"3","0")
=IF(ColorIndex($A$3)=6,"1","0")

Which if this worked the way it was supposed to, I could then simply SUM up the rows and there you have it. My problem is that when I highlight or "de-highlight" cells, it does not automatically update the values in AC,AD or AE.
I actually have to click on the formula in these cells individually and press enter before they'll update.

How do I get this to function automatically?

Thanks

MJ

 

[MJ72]

First, I think we have a big disconnect when you say columns A, B, and C. By your sample, I think you mean B, C, D, with the total going in column E, like so:

Book1
	A	B	C	D	E
1	Criteria	5	3	1	Total
2	Educational Background	High school not completed	High school graduate OR internationally Trained OR Registered Apprentice	College/University education not completed	0
Sheet3

That explains why you're getting the 1 overwriting another cell, because I didn't understand where you really wanted it.

Second, it might not have highlighted the cell because the technique I used to toggle the color depends on there being no fill of any other color in it first. If that's not the case, it might not have worked right. I changed to a slightly longer, but more robust method.

Here's the updated macro:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s As Long

    If Intersect(Target, Range("B:D")) Is Nothing Then Exit Sub
    Cancel = True
   
    If Target.Interior.ColorIndex = 6 Then
        Target.Interior.Pattern = xlNone
    Else
        Target.Interior.ColorIndex = 6
    End If
   
    s = 0
    If Cells(Target.Row, "B").Interior.ColorIndex = 6 Then s = s + 5
    If Cells(Target.Row, "C").Interior.ColorIndex = 6 Then s = s + 3
    If Cells(Target.Row, "D").Interior.ColorIndex = 6 Then s = s + 1
    Cells(Target.Row, "E") = s
   
End Sub

Now, when I double-click on the B2 cell, this is what happens:

Book1
	A	B	C	D	E
1	Criteria	5	3	1	Total
2	Educational Background	High school not completed	High school graduate OR internationally Trained OR Registered Apprentice	College/University education not completed	5
Sheet3

Is this what you want?

I believe we’re on the same page, Eric.
I apologize for the mix up, I left the first column out in my original explanation because I thought it to be irrelevant to the end goal. I will try this tomorrow.

 

[MJ72]

My script does not change the color of the cell.
I would like to get the results we want in column D
Then have you explain the thing about the cells color.
And from your last post we are dealing with columns A B C and D
Column D gets the final result

Thank you kindly, I will give this a try, as well, tomorrow.

 

[MJ72]

Try this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified  10/6/2022  5:03:21 PM  EDT
Cancel = True
Dim ans As Long

If Target.Column < 4 Then
ans = Target.Row

    Select Case Target.Column

        Case 1
            Cells(ans, 4).Value = Cells(ans, 4).Value + 5

        Case 2
            Cells(ans, 4).Value = Cells(ans, 4).Value + 3

        Case 3
            Cells(ans, 4).Value = Cells(ans, 4).Value + 1
    End Select
End If

End Sub

Good Morning "MAIT" thank you again for the attempt however this time we're receiving a Run-time error '13': Type mismatch. When I press "Debug" it highlights the line of code under "Case 3".

 

[My Aswer Is This]

Good Morning "MAIT" thank you again for the attempt however this time we're receiving a Run-time error '13': Type mismatch. When I press "Debug" it highlights the line of code under "Case 3".

Well I test all my scripts and it works for me.
I assume you have nothing in column 4 but numbers.
So if you double click on column 1 it should enter the number 5 to column 4
And so on with column 2 and 3

Now if you enter a textvalue into column 4 you will get a error because a text value like cake cannot be added to Cake+3 will cause a error

 

[MJ72]

Well I test all my scripts and it works for me.
I assume you have nothing in column 4 but numbers.
So if you double click on column 1 it should enter the number 5 to column 4
And so on with column 2 and 3

Now if you enter a textvalue into column 4 you will get a error because a text value like cake cannot be added to Cake+3 will cause a error

Thanks MAIT but Eric’s last solution worked well today

Well I test all my scripts and it works for me.
I assume you have nothing in column 4 but numbers.
So if you double click on column 1 it should enter the number 5 to column 4
And so on with column 2 and 3

Now if you enter a textvalue into column 4 you will get a error because a text value like cake cannot be added to Cake+3 will cause a error

Thanks MAIT, we’re all good. I used a what you posted last night and got it to work today!

 

[My Aswer Is This]

Glad you got something that works