How could I edit this marlett checkbox VBA code to automatically check them based on another cell's value?

I

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
160
Office Version
  1. 2016
Platform
  1. Windows
Hello. I have a workbook I created that tracks break times at my work. With formulas and private vba subs. We scan their badge and it puts the time in another column. In another column it adds 20 minutes, which is the time their break ends. In another column we scan their badge again and it inputs the time they came back. Then in another cell it subtracts the difference to give how much time they went over their break (column I). Format "0:05:45." So I have this VBA code that makes column K contain marlett checkboxes if there is any value in Column A. I use this as the "Late" column. If a person goes over 5 minutes I manually double click the cell. However I would like to automate this. How could I edit this code to double click the column K cell if the time in column I is over 5 minutes? I also would like to keep the rest of the code the same. Including the "offset line". Thank you to anyone willing to help!

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

With Target
If .Cells.Count = 1 And .Column = 11 And .EntireRow.Cells(1, 1) <> vbNullString Then
Cancel = True
If CStr(.Value) = vbNullString Then
.Value = "a"
Else
.Value = vbNullString
End If
.Offset(0, 1).Value = (.Value = "a")
.Font.Name = "Marlett"
.Font.Size = 14

End If
End With
End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Something to consider. I hate unnecessary key strokes. Drop this code in the Worksheet and every time any cell changes check Column I for => 5 if it is make K=Late if not clear K. Modify as necessary.
VBA Code: 
Sub WorkSheet_SelectionChange(ByVal Target As Range)
   Call CellInitiatedCode(Target.Address, Range(Target.Address).Value)
End Sub

Sub CellInitiatedCode(CellAddress, CellValue)

    If InStr(CellAddress, ":") > 0 Then
        'Ignore Multi Cell Selections
    Else
    
    'Find the last row basd on Colum I
    LastRow = Cells(Rows.Count, 9).End(xlUp).Row    '123456789
                                                    'ABCDEFGHI
    'This isn't needed, but is here in case you want to know what cell was selected
    SplitCellAddress = Split(CellAddress, "$")
    
        For x = 2 To LastRow    'assumes first row a heading
        
            splitColon = Split(FormatDateTime(Range("I" & x).Value, vbShortTime), ":")
        
            If CInt(splitColon(1)) >= 5 Then    '5 minutes
                Range("K" & x).Value = "Late"   'make K late
            Else
                Range("K" & x).Value = ""       'clear K
            End If
        Next
    
    End If
        
End Sub
 
Upvote 0
RayFrye said:
Something to consider. I hate unnecessary key strokes. Drop this code in the Worksheet and every time any cell changes check Column I for => 5 if it is make K=Late if not clear K. Modify as necessary.
VBA Code: 
Sub WorkSheet_SelectionChange(ByVal Target As Range)
   Call CellInitiatedCode(Target.Address, Range(Target.Address).Value)
End Sub

Sub CellInitiatedCode(CellAddress, CellValue)

    If InStr(CellAddress, ":") > 0 Then
        'Ignore Multi Cell Selections
    Else
   
    'Find the last row basd on Colum I
    LastRow = Cells(Rows.Count, 9).End(xlUp).Row    '123456789
                                                    'ABCDEFGHI
    'This isn't needed, but is here in case you want to know what cell was selected
    SplitCellAddress = Split(CellAddress, "$")
   
        For x = 2 To LastRow    'assumes first row a heading
       
            splitColon = Split(FormatDateTime(Range("I" & x).Value, vbShortTime), ":")
       
            If CInt(splitColon(1)) >= 5 Then    '5 minutes
                Range("K" & x).Value = "Late"   'make K late
            Else
                Range("K" & x).Value = ""       'clear K
            End If
        Next
   
    End If
       
End Sub
Click to expand...

Thanks for the reply. So I added this and it keeps giving me error 1004. "Application - defined or object - defined error." For line " Range("K" & x).Value = "" 'clear K." It also breaks the functionality of another Private Sub I have in the worksheet. One to enter in the current time in column C when a value is entered into a cell in column A. I added your code into the worksheet. Is this supposed to be a Private Sub also?
 
Upvote 0
Check out this page: Click for your error

VBA Runtime Error 1004 “Application-defined or Object-defined error”

The VBA Runtime Error 1004 can be caused by many things. In this article, I’ll show a few different situations and show how to deal with them.

VBA code refers to a range that doesn’t exist
This code usually happens when VBA code refers to a cell or range that doesn’t exist. For example, this code is correct.

add this before the Range("K" & x).Value = "" 'clear K.

on error resume next
debug.print Range("K" & x).Value

Then check the intermediate window to see if x is some crazy value.
 
Upvote 0
Subroutines should coexist. Private/Public is not necessary for this code to work, but Private will work .
 
Upvote 0
RayFrye said:
Check out this page: Click for your error

VBA Runtime Error 1004 “Application-defined or Object-defined error”

The VBA Runtime Error 1004 can be caused by many things. In this article, I’ll show a few different situations and show how to deal with them.

VBA code refers to a range that doesn’t exist
This code usually happens when VBA code refers to a cell or range that doesn’t exist. For example, this code is correct.

add this before the Range("K" & x).Value = "" 'clear K.

on error resume next
debug.print Range("K" & x).Value

Then check the intermediate window to see if x is some crazy value.
Click to expand...

I added it. Gives me no more errors. However it makes my workbook extremely slow and it doesn't check column K when it is over 5 minutes. Just inputs 4 symbols. Here are my other Subs in the worksheet for reference. Thank you for your help by the way.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Cells.Count = 1 Then
If Target.Value <> "" Then
Cells(Target.Row, "C").Value = Time
End If
End If
End If

If Not Intersect(Target, Range("G:G")) Is Nothing Then
If Target.Cells.Count = 1 Then
If Target.Value <> "" Then
Cells(Target.Row, "H").Value = Time
Target.NumberFormat = Chr(34) & "I'm Back" & Chr(34)
End If
End If
End If


End Sub

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

With Target
If .Cells.Count = 1 And .Column = 11 And .EntireRow.Cells(1, 1) <> vbNullString Then
Cancel = True
If CStr(.Value) = vbNullString Then
.Value = "a"
Else
.Value = vbNullString
End If
.Offset(0, 1).Value = (.Value = "a")
.Font.Name = "Marlett"
.Font.Size = 14

End If
End With
End Sub

Sub WorkSheet_SelectionChange(ByVal Target As Range)
Call CellInitiatedCode(Target.Address, Range(Target.Address).Value)
End Sub

Sub CellInitiatedCode(CellAddress, CellValue)

If InStr(CellAddress, ":") > 0 Then
'Ignore Multi Cell Selections
Else

'Find the last row basd on Colum I
LastRow = Cells(Rows.Count, 9).End(xlUp).Row '123456789
'ABCDEFGHI
'This isn't needed, but is here in case you want to know what cell was selected
SplitCellAddress = Split(CellAddress, "$")

For x = 2 To LastRow 'assumes first row a heading

splitColon = Split(FormatDateTime(Range("I" & x).Value, vbShortTime), ":")

If CInt(splitColon(1)) >= 1 Then '5 minutes
Range("K" & x).Value = "Late" 'make K late
Else

On Error Resume Next
Debug.Print Range("K" & x).Value

Range("K" & x).Value = "" 'clear K
End If
Next

End If

End Sub
 
Upvote 0
For starters...
Not correct and not what I suggested:
If CInt(splitColon(1)) >= 1 Then '5 minutes
Should be:
If CInt(splitColon(1)) >= 5 Then '5 minutes
 
Upvote 0
I have your code in my Worksheet and Column I and K work ok.
Other code doesn't fire
 
Upvote 0
RayFrye said:
For starters...
Not correct and not what I suggested:
If CInt(splitColon(1)) >= 1 Then '5 minutes
Should be:
If CInt(splitColon(1)) >= 5 Then '5 minutes
Click to expand...

I edited that part of the code just for testing it so I didn’t have to wait an entire 5 minutes. Will try it again and report back.
 
Upvote 0
Ahh, I suspect that. If CInt(splitColon(1)) >= 1 is fine for testing.

Not sure your other code does, my code was intended to make it show immediately; no need to execute the double-click.
But I don't see you entire effort, so might have missed the boat on this one.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
442
bobsan42
bobsan42
F
  • Solved
Combine 2 VBA codes in one module (double click to jump to another sheet)
Replies
3
Views
101
Michael M
Michael M
E
  • Question
VB Help with code to copy selected rows to specified cells in another sheet.
2
Replies
12
Views
537
Excel_Assis
E
A
  • Solved
Change cell values with VBA code
Replies
1
Views
153
rpaulson
rpaulson
U
  • Solved
Using checkboxes to populate a value if they are checked
2
Replies
11
Views
1K
kevin9999
K

Forum statistics

Threads
1,217,290
Messages
6,135,657
Members
449,955
Latest member
ysfuyar

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top