Timesheet add a row based on inputbox entry

[cbye]

Hi, I have a timesheet that I need to be able to add a row if the employee worked a double shift. The VBA code that I found seems to be what I need but when I input the date I get "Input not found in range" message. Im not sure what Im missing.

Sub Date_Finder()

Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet '<-- Update
Dim xInput As Date, Found As Range

xInput = Application.InputBox("Enter Date [mm/dd/yyyy]", Type:=1)

If IsDate(xInput) Then
Set Found = ws.Range("B:B").Find(xInput)

If Found Is Nothing Then
MsgBox "Input not found in range"
Else
Found.Offset(1).EntireRow.Insert (xlShiftDown)
Found.Offset(1).EntireRow.Insert (xlShiftDown)
End If
Else
MsgBox "Invalid Entry. Ending sub" & vbNewLine & "Entry: " & xInput, vbCritical
End If

End Sub

Monthly Timesheet.xlsm
	A	B	C	D	E	F
1
2		Monthly timesheet
3
4		EMPLOYEE:	John Doe			7/1/23
5
6		Company:	Company X			8.00
7
8		DATE	Start time	Finish time	Regular hrs	TOTAL HOURS
9		Sat, 1 Jul			0.00	0.00
10		Sun, 2 Jul			0.00	0.00
11		Mon, 3 Jul			0.00	0.00
12		Tue, 4 Jul			0.00	0.00
13		Wed, 5 Jul			0.00	0.00
14		Thu, 6 Jul			0.00	0.00
15		Fri, 7 Jul			0.00	0.00
16		Sat, 8 Jul			0.00	0.00
17		Sun, 9 Jul			0.00	0.00
18		Mon, 10 Jul			0.00	0.00
19		Tue, 11 Jul			0.00	0.00
20		Wed, 12 Jul			0.00	0.00
21		Thu, 13 Jul			0.00	0.00
22		Fri, 14 Jul			0.00	0.00
23		Sat, 15 Jul			0.00	0.00
24		Sun, 16 Jul			0.00	0.00
25		Mon, 17 Jul			0.00	0.00
26		Tue, 18 Jul			0.00	0.00
27		Wed, 19 Jul			0.00	0.00
28		Thu, 20 Jul			0.00	0.00
29		Fri, 21 Jul			0.00	0.00
30		Sat, 22 Jul			0.00	0.00
31		Sun, 23 Jul			0.00	0.00
32		Mon, 24 Jul			0.00	0.00
33		Tue, 25 Jul			0:00	0.00
34		Wed, 26 Jul			0.00	0.00
35		Thu, 27 Jul			0.00	0.00
36		Fri, 28 Jul			0.00	0.00
37		Sat, 29 Jul			0.00	0.00
38		Sun, 30 Jul			0.00	0.00
39
40		TOTAL H	---	---	0.00	0.00
41		HOURLY RATE	---	---		---
42		TOTAL PAY	---	---	$0.00	$0.00
43
44						0.00
45						TOTAL HOURS
46
47						$0.00
48						TOTAL PAY
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Timesheet July 2023

Cell Formulas
Range	Formula
E9:E38	E9	=IF(I9>$F$6,$F$6,I9)
F9:F38	F9	=MOD((D9-C9),1)*24
B9	B9	=F4
B10:B38	B10	=B9+1
E40	E40	=SUM(E9:E39)
F40,F42	F40	=SUM(E40:E40)
E42	E42	=E41*E40
F44	F44	=F40
F47	F47	=F42

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C9:C30,C33:C39	Cell	contains a blank value	text	NO
C9:C30,C33:C39	Cell Value	>"24:00:00"	text	NO

 

[Skyybot]

What's the Cell format of the data in Column B. I would think that it should be Date.

 

[dmt32]

Hi

using Range.Find to locate dates can be a problem but try this update to your code & see if does what you want

Sub Date_Finder()
    
    Dim ws              As Worksheet
    Dim xInput         As Variant
    Dim Found        As Range
    
    Set ws = ThisWorkbook.ActiveSheet        '<-- Update
    
    Do
        xInput = InputBox("Enter Date [mm/dd/yyyy]")
        'cancel pressed
        If StrPtr(xInput) = 0 Then Exit Sub
    Loop Until xInput Like "##/##/####" And IsDate(xInput)
    
    xInput = DateValue(xInput)
    
    Set Found = ws.Columns(2).Find(xInput, LookIn:=xlFormulas, LookAt:=xlWhole)
    
    If Not Found Is Nothing Then
    
        Found.Offset(1).Resize(2).EntireRow.Insert (xlShiftDown)
        
    Else
    
        MsgBox xInput & Chr(10) & "Input Not found in range", 48, "Not Found"
        
    End If
    
End Sub

Dave

 

[cbye]

What's the Cell format of the data in Column B. I would think that it should be Date.

 

[cbye]

What's the Cell format of the data in Column B. I would think that it should be Date.

Hey Skybot, I took a screenshot of the format. Also in my immediate window if I issue a ?isdate(activecell) it comes back as True. And ?range("B14").value it comes back as 7/6/2023

 

[cbye]

Hi

using Range.Find to locate dates can be a problem but try this update to your code & see if does what you want

Sub Date_Finder()
   
    Dim ws              As Worksheet
    Dim xInput         As Variant
    Dim Found        As Range
   
    Set ws = ThisWorkbook.ActiveSheet        '<-- Update
   
    Do
        xInput = InputBox("Enter Date [mm/dd/yyyy]")
        'cancel pressed
        If StrPtr(xInput) = 0 Then Exit Sub
    Loop Until xInput Like "##/##/####" And IsDate(xInput)
   
    xInput = DateValue(xInput)
   
    Set Found = ws.Columns(2).Find(xInput, LookIn:=xlFormulas, LookAt:=xlWhole)
   
    If Not Found Is Nothing Then
   
        Found.Offset(1).Resize(2).EntireRow.Insert (xlShiftDown)
       
    Else
   
        MsgBox xInput & Chr(10) & "Input Not found in range", 48, "Not Found"
       
    End If
   
End Sub

Dave

Hi Dave, thanks for replying. I tried your code but once I input the date in the window and click ok, it presents the window again and doesn't add a row.

 

[dmt32]

Hi Dave, thanks for replying. I tried your code but once I input the date in the window and click ok, it presents the window again and doesn't add a row.

As I stated, Range.Find when searching for dates can be a problem

PROVIDING the dates in your range are all in a consistent format you can try this update & see if resolves the issue

Sub Date_Finder()
  
    Dim ws              As Worksheet
    Dim xInput         As Variant
    Dim Found        As Range
  
    Const DateFormat As String = "mm/dd/yyyy" '< change as required
  
    Set ws = ThisWorkbook.ActiveSheet        '<-- Update
  
    Do
        xInput = InputBox("Enter Date [" & DateFormat & "]")
        'cancel pressed
        If StrPtr(xInput) = 0 Then Exit Sub
    Loop Until xInput Like "##/##/####" And IsDate(xInput)
  
    xInput = Format(DateValue(xInput), DateFormat)
  
    Set Found = ws.Columns(2).Find(xInput, LookIn:=xlValues, LookAt:=xlWhole)
  
    If Not Found Is Nothing Then
  
        Found.Offset(1).Resize(2).EntireRow.Insert (xlShiftDown)
      
    Else
  
        MsgBox xInput & Chr(10) & "Input Not found in range", 48, "Not Found"
      
    End If
  
End Sub

Dave

 

[Skyybot]

Hey Skybot, I took a screenshot of the format. Also in my immediate window if I issue a ?isdate(activecell) it comes back as True. And ?range("B14").value it comes back as 7/6/2023

View attachment 96244

Try this custom format.
ddd,d mmm
Since you're looking for a full Date in the VBA code you may nee to add Year data?
ddd,m/d/yyyy

 

[cbye]

Thanks again for both of your inputs. I think Im understanding that with Dave's code, the date formats in green and my cell range format need to match 1 for 1. When I set my range format to dd/mm/yyyy it works! It was adding 2 rows though. I changed the .Resize to 1 and it now adds 1 row. Thanks.

To take this one step further, I would like for the date cell of the new row to auto populate with the date that was entered initially. Would that the xInput? Or would it just be easier to copy the B cell just above the inserted row?







Sub Date_Finder()

Dim ws As Worksheet
Dim xInput As Variant
Dim Found As Range

Const DateFormat As String = "dd/mm/yyyy" '< change as required

Set ws = ThisWorkbook.ActiveSheet '<-- Update

Do
xInput = InputBox("Enter Date [" & DateFormat & "]")
'cancel pressed
If StrPtr(xInput) = 0 Then Exit Sub
Loop Until xInput Like "##/##/####" And IsDate(xInput)

xInput = Format(DateValue(xInput), DateFormat)

Set Found = ws.Columns(2).Find(xInput, LookIn:=xlValues, LookAt:=xlWhole)

If Not Found Is Nothing Then

Found.Offset(1).Resize(2).EntireRow.Insert (xlShiftDown)

Else

MsgBox xInput & Chr(10) & "Input Not found in range", 48, "Not Found"

End If

End Sub

 

[Skyybot]

Try adding this

Found.Offset(1).Resize(1).EntireRow.Insert (xlShiftDown)
Found.Offset(1).Value = xInput     '<--------------added line