Checkboxes vs Drop Downs

[usnapoleon]

Hello,
I could use an honest opinion on a project before I expend time and energy into it. I was on this forum recently getting help in making a spreadsheet where input is heavily involving checkboxes. A single tab looked like this:

There are 31 tabs total, to represent the days of the month, and 37 rows of the checkboxes per tab. One thing I noticed is that the spreadsheet was slow, and likely due to all the checkboxes.

The spreadsheet works by checking 1 box on the Department area, and one box in the Voucher Type area. The black areas get populated with the checkbox-selections, and there are sumif formulas above that review the black areas and the amount $$ in the far right and bango, we have an easy-to-input spreadsheet that gives us our info. The whole intention was to make the input area easy with the use of checkboxes. It's been much easier, well received, but its nagging me that it's a slow spreadsheet, and modifying it (adding/removing checkboxes) is a pain in the butt.

What I'm envisioning is this...

We have 1 'input' area, which utilizes 2 dropdown menus you see at the top, and the amount is a simple input. you press a button, which I called above the 'post' button... and it will post the data in the area below - I color-coordinated the input sections to where they get posted, just as a visual aid. The formulas I mentioned will do sumif's based on the posted area, no biggie here. Each time you 'Post' it will apply the selected items to the next empty row. You can make edits after-the-fact, or clear data altogether if you want to redo it, etc.

• So if you clear row 30 because of an input-accident, you can highlight the row, clear it, and the 'post' button will re-use row 30.
• Or maybe you didnt see the input error initially, and you get to row 35 before you caught it.
  • You can delete the row entirely, which will bump up all the other rows... so 32 becomes 31, etc etc, and 35's the next blank row and your 'redo' goes there.
  • Alternatively, maybe you just cleared out row 30, so rows 29, 31-34 are populated but 30 no longer is, the Post will go there, then the next one will resume at row 35.

My questions to everyone reading...

1. is something like this possible?
2. will it be a faster spreadsheet?

Thank you for your time!

 

[My Aswer Is This]

He is a sample of a script that uses Message Box

Try it and see what happens in the active cell row

So in our case we double click on any cell in column A
And you would choose Yes or No if you want the script to run
This is just an example of how user is given a change to run a script or stop it.

Private Sub CommandButton1_Click()
Dim ans As String
Dim rr As Long
rr = ActiveCell.Row

ans = MsgBox("Do You want to clear this row", vbYesNo)
If ans = vbYes Then Rows(rr).Clear

If ans = vbNo Then MsgBox "I stopped The Script"
End Sub

 

[usnapoleon]

@My Aswer Is This
I like your approach to deal with this problem, I think it's efficient & user-friendly.
If you don't mind, I'd like to try to amend your code to address the 2 type mistakes that the OP mentioned earlier.

@usnapoleon
If you interested, could you please upload a sample workbook (without sensitive data) to a file-sharing site like Dropbox.com or Google Drive, and then share the link here? Also, ensure that the link is accessible to anyone.

Let me know if this doesnt work!

Voucher Template mess - Copy.xlsm

Shared with Dropbox

www.dropbox.com

 

[My Aswer Is This]

Sounds as if someone else wants to help you.
So, I will step aside and just keep watching.
Take care and I'm sorry my approach did not satisfy your needs

 

[Akuini]

Ok, here's what I get so far, see if it's on the right direction.
I removed col A (clearing column), because I don't think you need it.
The code doesn't preserve the original cell color, but if you want I can amend the code to do that.

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

Dim xDepartment As Range, xVoucher As Range

On Error GoTo skip:

Set xDepartment = Range("C22:J58") 'Department is in this range
Set xVoucher = Range("L22:P58")    'Voucher Type  is in this range

    If Not Intersect(Target, Union(xDepartment, xVoucher)) Is Nothing Then
        Cancel = True
        With Target
        Application.EnableEvents = False
        Select Case .Column
            Case 3 To 10                        'Department is in col 3 To 10
                If .Interior.Color = vbBlue Then
                    Intersect(.EntireRow, xDepartment).Interior.Color = xlNone
                    Cells(.Row, "K") = ""
                Else
                    Intersect(.EntireRow, xDepartment).Interior.Color = xlNone
                    .Interior.Color = vbBlue
                    Cells(.Row, "K") = Cells(20, .Column)  'header in row 20
                End If
            Case 12 To 16                       'Voucher Type is in col 12 To 16
                If .Interior.Color = vbBlue Then
                    Intersect(.EntireRow, xVoucher).Interior.Color = xlNone
                    Cells(.Row, "Q") = ""
                Else
                    Intersect(.EntireRow, xVoucher).Interior.Color = xlNone
                    .Interior.Color = vbBlue
                    Cells(.Row, "Q") = Cells(20, .Column) 'header in row 20
                End If
                
        End Select
        Application.EnableEvents = True
        End With
    End If

Exit Sub
skip:
Application.EnableEvents = True
MsgBox "Error number " & Err.Number & " : " & Err.Description

End Sub

The workbook:

usnapoleon - Voucher Template mess - Akuini #1

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[usnapoleon]

Ok, here's what I get so far, see if it's on the right direction.
I removed col A (clearing column), because I don't think you need it.
The code doesn't preserve the original cell color, but if you want I can amend the code to do that.

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

Dim xDepartment As Range, xVoucher As Range

On Error GoTo skip:

Set xDepartment = Range("C22:J58") 'Department is in this range
Set xVoucher = Range("L22:P58")    'Voucher Type  is in this range

    If Not Intersect(Target, Union(xDepartment, xVoucher)) Is Nothing Then
        Cancel = True
        With Target
        Application.EnableEvents = False
        Select Case .Column
            Case 3 To 10                        'Department is in col 3 To 10
                If .Interior.Color = vbBlue Then
                    Intersect(.EntireRow, xDepartment).Interior.Color = xlNone
                    Cells(.Row, "K") = ""
                Else
                    Intersect(.EntireRow, xDepartment).Interior.Color = xlNone
                    .Interior.Color = vbBlue
                    Cells(.Row, "K") = Cells(20, .Column)  'header in row 20
                End If
            Case 12 To 16                       'Voucher Type is in col 12 To 16
                If .Interior.Color = vbBlue Then
                    Intersect(.EntireRow, xVoucher).Interior.Color = xlNone
                    Cells(.Row, "Q") = ""
                Else
                    Intersect(.EntireRow, xVoucher).Interior.Color = xlNone
                    .Interior.Color = vbBlue
                    Cells(.Row, "Q") = Cells(20, .Column) 'header in row 20
                End If
               
        End Select
        Application.EnableEvents = True
        End With
    End If

Exit Sub
skip:
Application.EnableEvents = True
MsgBox "Error number " & Err.Number & " : " & Err.Description

End Sub

The workbook:

usnapoleon - Voucher Template mess - Akuini #1

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

Hi Akuini
This worked perfectly! Double clicking a blue removed the color and the text inputted in columns K (or Q, depending on where the Blue was).

I'm trying to understand the code. The previous code was very clear once I understood the meaning behind 'offset' and it was very clean such that I will have to remember it for a future project. This code is a bit more so I just want to see how much I can follow...

I get this part is saying 'if the cell is already blue then make it no-color and remove the text in column K for that row. That seems to be the general function. What I dont know is...

1) what 'intersect' is,

2) how does '.EntireRow' work? It's not working on the 'entire' row. I feel the defined xDepartment of being C22:J58 has something to do with it

3) what is cells(.Row, "K") ? I just looked and saw that the cell function is Cells(row, column). So here we are clearly defining column K, but what does .Row mean? is it like 'this row'? so it would be Cells('this row we're working on', column k)? I kind of think so, because I see in the Else section

and I see .Column used. I get that this is where it pulls the department initials from row 20 and inputs it into column K. If I understand it right, and I put it into works, this code is saying "this row (.Row) in column K is (=) whatever is in row 20 on this column (.Column)"?

I see how you defined the ranges too, thank you... I feel stupid for not figuring that out, but I knew we had to define them somehow. So if we add more rows (maybe its a really busy day) then we'll need to modify the code. Knowing this, I might just add a bunch more rows just in case, and save me the trouble later! I think this finalized the outstanding issues I had.

Thank you very much. Between you and @My Aswer Is This I have learned a lot (though still not even scratching the surface! You guys are very amazing. I am looking forward to making my 31 tabs for the days of the month and showing this to the team! Thank you both again!

 

[Akuini]

Hi Akuini
This worked perfectly! Double clicking a blue removed the color and the text inputted in columns K (or Q, depending on where the Blue was).

I'm glad the code works. I'll explain what the code does in more detail later when I have time. However, I noticed in your file you have this note:
'This happens if the checkbox is wrong, such as dept TH with SB vouchers.'
My understanding is that certain departments can only have certain vouchers. So, what happen if users pick a wrong voucher, they instantly realize that? how?
I think it would be good if users try to pick the wrong voucher, then a message will pop up saying 'You can't choose this voucher' and the cell will remain without color. If you're interested, I can amend the code to do that, but I need to know where the list of department-voucher is located."

 

[usnapoleon]

I'm glad the code works. I'll explain what the code does in more detail later when I have time. However, I noticed in your file you have this note:
'This happens if the checkbox is wrong, such as dept TH with SB vouchers.'
My understanding is that certain departments can only have certain vouchers. So, what happen if users pick a wrong voucher, they instantly realize that? how?
I think it would be good if users try to pick the wrong voucher, then a message will pop up saying 'You can't choose this voucher' and the cell will remain without color. If you're interested, I can amend the code to do that, but I need to know where the list of department-voucher is located."

Hi Akuini, I think this section we'll leave alone. I keep it as an auditing tool for the team to learn from too. I just made the spreadsheet, I'm so very stoked for it!! Thank you very much again!!!!!

 

[Akuini]

Ok, here are some explanation:
1) what 'intersect' is,
Intersect means intersection of 2 or more ranges, for example:
Sub test()
MsgBox Intersect(Range("A3:D3"), Range("B1:C5")).Address 'returns $B$3:$C$3
End Sub
Check out this article:

https://www.wallstreetmojo.com/vba-intersect/

2) how does '.EntireRow' work? It's not working on the 'entire' row. I feel the defined xDepartment of being C22:J58 has something to do with it
Yes, and it has something to do with "intersect", so it captures the row in col C:J only
Check out rhis article:
Excel VBA Intersect Method. Using Intersect in Excel VBA

3) what is cells(.Row, "K") ?
It has something to do with "With...End With" statement, in this case "With Target...End With".
".Row" means Target.Row because it's inside "With Target...End With" statement.
Check out this article:
VBA With Statement (With - End With)

I amended the code enhance its flexibility & add some comments.
I also have a challenge for you in the code:
Challenge: please add some comments to this part (Voucher) similar to the comments above (in Department)

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

Dim xDepartment As Range, xVoucher As Range

On Error GoTo skip:

Set xDepartment = Range("C22:J58") 'Department is in this range
Set xVoucher = Range("L22:P58")    'Voucher Type  is in this range
    'Target is the cell which you double-clik
    
    If Not Intersect(Target, Union(xDepartment, xVoucher)) Is Nothing Then 'if Target intersect with xDepartment or xVoucher
        Cancel = True
        With Target
            Application.EnableEvents = False
            
            'for example: if Target is D25. it means Target.Row is 25 & Target.column is D
            If Not Intersect(Target, xDepartment) Is Nothing Then 'if D25 intersect with xDepartment
                    If .Interior.Color = vbBlue Then                                'if D25 color is already blue then
                        Intersect(.EntireRow, xDepartment).Interior.Color = xlNone  'remove color in row 25 in the part that intersect with xDepartment, it would be "C25:J25"
                        Cells(.Row, "K") = ""  'clear value of row 25, col K
                    Else                                                            'if D25 color is NOT blue then
                        Intersect(.EntireRow, xDepartment).Interior.Color = xlNone  'remove color in row 25 in the part that intersect with xDepartment, it would be "C25:J25"
                        .Interior.Color = vbBlue                                    'apply blue color to D25
                        Cells(.Row, "K") = Cells(20, .Column)  'send value of header (row 20) & col D  to row 25 col K   '
                    End If
             
            'Challenge: please add some comments to this part (Voucher) similar to the comments above (in Department)
            'for example: if Target is N22
             ElseIf Not Intersect(Target, xVoucher) Is Nothing Then '
                    If .Interior.Color = vbBlue Then
                        Intersect(.EntireRow, xVoucher).Interior.Color = xlNone
                        Cells(.Row, "Q") = ""
                    Else
                        Intersect(.EntireRow, xVoucher).Interior.Color = xlNone
                        .Interior.Color = vbBlue
                        Cells(.Row, "Q") = Cells(20, .Column)  '
                    End If
            End If
            Application.EnableEvents = True
        End With
    End If

Exit Sub
skip:
Application.EnableEvents = True
MsgBox "Error number " & Err.Number & " : " & Err.Description

End Sub

 

[My Aswer Is This]

Glad to see your getting what you need.
You said:
I'm trying to understand the code. The previous code was very clear once I understood the meaning behind 'offset' and it was very clean such that I will have to remember it for a future project. This code is a bit more so I just want to see how much I can follow..."

I myself surely do not understand the above code. But if it works for you that's what's important.

You mentioned Offset.

Here is an example of offset:
If can mean up down left right

Try this on empty worksheet and see what it does.

Private Sub CommandButton1_Click()
Range("A10").Offset(3, 5).Value = "Hello"
Range("G10").Offset(-3, -4).Value = "Goodbye"
End Sub