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

 

[cbye]

Try adding this

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

Thanks that works. I appreciate your help. And I learned a bit more.