I am receiving error 1004 when I try to run the Update Command and select "Yes" from the message box. I have compared the code to similar I use successfully in another file.
So far this error only happens for the "UPDATE" Command following a DATE SEARCH request, however I have provided the entire code as the problem might be caused by another Private Sub
DEBUG shows the error initially occurs at Cells(CurrentRow, 1).Value = DTPicker1.Value and when I exclude this line and "CONTINUE" the error moves on to the next line. This repeats as each line is excluded.
So far this error only happens for the "UPDATE" Command following a DATE SEARCH request, however I have provided the entire code as the problem might be caused by another Private Sub
DEBUG shows the error initially occurs at Cells(CurrentRow, 1).Value = DTPicker1.Value and when I exclude this line and "CONTINUE" the error moves on to the next line. This repeats as each line is excluded.
VBA Code:
Dim CurrentRow As Long
Private Sub UserForm_Initialize()
DTPicker1.Value = ""
cboSchedulingType.Value = ""
cboLocation.Value = ""
txtStartTime.Value = "00:00"
txtStartTime.MaxLength = 5
txtFinishTime.Value = "00:00"
txtFinishTime.MaxLength = 5
cboPayRate.Value = ""
CheckBoxPete.Value = False
CheckBoxKirsty.Value = False
CheckBoxJan.Value = False
CheckBoxKelly.Value = False
CheckBoxCarla.Value = False
txtWorkDate.Value = ""
txtDailyPayMonth.Value = ""
txtDailyWorkHours.Value = ""
txtDailyLeaveHours.Value = ""
txtDailyNonWorkingDay.Value = ""
txtDailyEarningsGross.Value = ""
txtMonthlyWorkHours.Value = ""
txtDailyEarningsGross.Value = ""
txtMonthlyPayMonth.Value = ""
txtMonthlyWorkHours.Value = ""
txtMonthlyWorkEarningsGross.Value = ""
txtMonthlyLeaveHours.Value = ""
txtMonthlyLeaveEarningsGross.Value = ""
txtTotalMonthlyEarningsGross.Value = ""
txtDateSearch.Value = ""
cboPayMonthSearch.Value = ""
DTPicker1.SetFocus
End Sub
Private Sub txtStartTime_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(txtStartTime.Value) And Len(txtStartTime.Text) = 5 Then
Else
MsgBox "Input Start Time as for example 09:15"
txtStartTime.Text = ""
End If
End Sub
Private Sub txtEndTime_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(txtEndTime.Value) And Len(txtEndTime.Text) = 5 Then
Else
MsgBox "Input End Time as for example 09:15"
txtEndTime.Text = ""
End If
End Sub
Private Sub cmdInputRecords_Click()
Dim lastrow As Long
answer = MsgBox("Add the Record?", vbYesNo + vbQuestion, "Add Record?")
If answer = vbNo Then
Call UserForm_Initialize
DTPicker1.SetFocus
Else
lastrow = Sheets("Daily Hours Input").Range("A" & Rows.Count).End(xlUp).Row
Cells(lastrow + 1, "A").Value = DTPicker1
Cells(lastrow + 1, "B").Value = cboSchedulingType
Cells(lastrow + 1, "C").Value = cboLocation
Cells(lastrow + 1, "E").Value = txtStartTime
Cells(lastrow + 1, "F").Value = txtFinishTime
Cells(lastrow + 1, "K").Value = cboPayRate
Cells(lastrow + 1, "M").Value = CheckBoxPete
Cells(lastrow + 1, "N").Value = CheckBoxKirsty
Cells(lastrow + 1, "O").Value = CheckBoxJan
Cells(lastrow + 1, "P").Value = CheckBoxKelly
Cells(lastrow + 1, "Q").Value = CheckBoxCarla
MsgBox "Record has been added to the database", 0, "Record Added"
With ActiveSheet
Application.Goto Reference:=.Cells(.Rows.Count, "A").End(xlUp).Offset(-20), Scroll:=True
End With
Call UserForm_Initialize
DTPicker1.SetFocus
End If
End Sub
Private Sub cboPayRate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim payrate As Double
payrate = cboPayRate.Value
cboPayRate.Value = Format(cboPayRate.Value, "Currency")
End Sub
Private Sub cmdClearForm_Click()
'Clears the User Form
Call UserForm_Initialize
End Sub
Private Sub cmdCloseForm_Click()
'Closes the User Form
Unload Me
End Sub
Private Sub cmdDateSearch_Click()
'Used to search for records for a specific date
Dim Res As Variant
Dim lastrow
Dim myFind As String
Dim CurrentRow As Long
Res = Application.Match(CDbl(CDate(txtDateSearch)), Sheets("Daily Hours Input").Range("A:A"), 0)
If IsError(Res) Then
MsgBox "Date Not Found", vbInformation, "Date Not Found"
Call UserForm_Initialize
txtDateSearch.SetFocus
Exit Sub
End If
lastrow = Sheets("Daily Hours Input").Range("A" & Rows.Count).End(xlUp).Row
myFind = txtDateSearch
For CurrentRow = 2 To lastrow
If Cells(CurrentRow, 1).Value = myFind Then
DTPicker1.Value = Cells(CurrentRow, 1)
cboSchedulingType.Value = Cells(CurrentRow, 2)
cboLocation.Value = Cells(CurrentRow, 3)
txtStartTime.Value = Cells(CurrentRow, 5)
txtFinishTime.Value = Cells(CurrentRow, 6)
cboPayRate.Value = Cells(CurrentRow, 11)
CheckBoxPete.Value = Cells(CurrentRow, 13)
CheckBoxKirsty.Value = Cells(CurrentRow, 14)
CheckBoxJan.Value = Cells(CurrentRow, 15)
CheckBoxKelly.Value = Cells(CurrentRow, 16)
CheckBoxCarla.Value = Cells(CurrentRow, 17)
txtWorkDate.Value = Cells(CurrentRow, 1).Value
txtDailyPayMonth.Value = Cells(CurrentRow, 4).Value
txtDailyEarningsGross.Value = Cells(CurrentRow, 12).Text
If Cells(CurrentRow, 2).Value = "Work" Then
txtDailyWorkHours.Value = Cells(CurrentRow, 10).Value
ElseIf Cells(CurrentRow, 2).Value = "Leave" Then
txtDailyLeaveHours.Value = Cells(CurrentRow, 10).Value
ElseIf Cells(CurrentRow, 2).Value = "Non-Working Day" Then
txtDailyNonWorkingDay.Value = "Yes"
End If
End If
Next CurrentRow
End Sub
Private Sub cmdUpdateRecords_Click()
'Used to update existing records
Dim CurrentRow As Long
answer = MsgBox("Update the Record?", vbYesNo + vbQuestion, "Update Record?")
If answer = vbNo Then
Call UserForm_Initialize
DTPicker1.SetFocus
Else
Cells(CurrentRow, 1).Value = DTPicker1.Value
Cells(CurrentRow, 2).Value = cboSchedulingType.Value
Cells(CurrentRow, 3).Value = cboLocation.Value
Cells(CurrentRow, 5).Value = txtStartTime.Value
Cells(CurrentRow, 6).Value = txtFinishTime.Value
Cells(CurrentRow, 11).Value = cboPayRate.Value
Cells(CurrentRow, 13).Value = CheckBoxPete.Value
Cells(CurrentRow, 14).Value = CheckBoxKirsty.Value
Cells(CurrentRow, 15).Value = CheckBoxJan.Value
Cells(CurrentRow, 16).Value = CheckBoxKelly.Value
Cells(CurrentRow, 17).Value = CheckBoxCarla.Value
MsgBox "Record has been Updated", 0, "Record Updated"
Call UserForm_Initialize
DTPicker1.SetFocus
End If
End Sub
Any help is most appreciated
