Excel table with columns checkboxes

[marcialfa]

Hello,

If anyone can help me with this matter I will be very grateful.

What I have is a list of columns with checkboxes and I want at the bottom of each column to be a total !


Thank you!

here is a picture of the file

https://ibb.co/d2Hh7m

 

[My Aswer Is This]

Try this:
The range has been changed.
It's easier to not use buttons.

This still works the same with different range.
But now if a mistake is made the user needs to Right click on the cell they want to change and they will get a Message asking if their sure and if they say yes the correction will be made.


If the user installs the script just like you did it should work for them.
Now you should know all users must have macros enable

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column < 33 And Target.Column > 2 And Target.Row > 3 Then
Cancel = True
Dim lastrow As Long
Dim More As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
More = lastrow - 3
If Target.Interior.ColorIndex = 4 Then MsgBox "You have allready answered that question": Exit Sub
    Cells(2, Target.Column).Value = Cells(2, Target.Column).Value + 1
    Cells(3, Target.Column).Value = Cells(2, Target.Column).Value / More
    Target.Interior.ColorIndex = 4
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column < 33 And Target.Column > 2 And Target.Row > 3 Then
Cancel = True
    If Target.Interior.ColorIndex = 4 Then
        ans = MsgBox("Are you sure you want to change", vbYesNo)
            If ans = vbYes Then
                Target.Interior.ColorIndex = xlNone
                Cells(2, Target.Column).Value = Cells(2, Target.Column).Value - 1
                lastrow = Cells(Rows.Count, "A").End(xlUp).Row
                More = lastrow - 3
                Cells(3, Target.Column).Value = Cells(2, Target.Column).Value / More
            End If
    End If
End If
 End Sub

 

[My Aswer Is This]

I see I made one mistake:
Try this: works like I explained in previous post:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column < 33 And Target.Column > 2 And Target.Row > 3 Then
Cancel = True
Dim lastrow As Long
Dim More As Long
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
More = lastrow - 3
If Target.Interior.ColorIndex = 4 Then MsgBox "You have allready answered that question": Exit Sub
    Cells(2, Target.Column).Value = Cells(2, Target.Column).Value + 1
    Cells(3, Target.Column).Value = Cells(2, Target.Column).Value / More
    Target.Interior.ColorIndex = 4
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column < 33 And Target.Column > 2 And Target.Row > 3 Then
Cancel = True
    If Target.Interior.ColorIndex = 4 Then
        ans = MsgBox("Are you sure you want to change", vbYesNo)
            If ans = vbYes Then
                Target.Interior.ColorIndex = xlNone
                Cells(2, Target.Column).Value = Cells(2, Target.Column).Value - 1
                lastrow = Cells(Rows.Count, "C").End(xlUp).Row
                More = lastrow - 3
                Cells(3, Target.Column).Value = Cells(2, Target.Column).Value / More
            End If
    End If
End If
 End Sub

 

[marcialfa]

Amazing... Thank you ever so much ! everything works perfectly !

 

[My Aswer Is This]

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

Amazing... Thank you ever so much ! everything works perfectly !