VBA code for finding date sometimes doesn't work.

M

mysticmario

Active Member
Joined
Nov 10, 2021
Messages
323
Office Version
  1. 365
Platform
  1. Windows
Hi, I have this bit of code:
VBA Code: 
    'find date'
    dateValue = Val(Me.DateRange.Value)
    Set dRng = Range("D7:J7")
    For a = 0 To 14 'range of 15 arrays of dates
        Set emptyCell = dRng.Find(What:=CDate(dateValue), LookIn:=xlValues, LookAt:=xlWhole)
        Exit Sub
            Dim colNum As Integer
        colNum = emptyCell.Column 'get the column number where the date was found
        For b = emptyCell.Row + 1 To emptyCell.Row + 32 'start the loop from the next row of the found date cell
            If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
                Set emptyCell = Cells(b, colNum)
                    ' Add jobtype and hours
                    emptyCell.Value = Me.HoursCount.Value
                    Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                    Cells(emptyCell.Row, "B").Value = Me.employee.Value
                    Exit For
                End If
            Next b        
            If Not emptyCell Is Nothing Then Exit For
        Else
            Set dRng = dRng.Offset(60, 0)
        End If
    Next a
    If emptyCell Is Nothing Then
        MsgBox "No empty cell available below " & dRng.Address
        Exit Sub
    End If
I encounter the problem that for some reason this code sometimes stops working and acts as if the DateValue does not exist on the sheet.
So for example I hzve a date 23.02.2023 as DateValue I press the submit button and it finds the date then finds the next emptyCell in the column where the date was found and in the end adds value to this empty cell and 2 other cells in column B and C.
Then all of a sudden I peess submit after few minutes of coding and the same date is not found and goes straight to he else statement sayign there is not value like this on this sheet.
When I switch to that sheet the date is there of course, but I delete the formula that results in this date, in this example it's a D67 cell with formula "=C64" inside, retype it again restart excel and the code works fine again.
I dont knwo if it a result of shared workboook being worked in VBa on the backend that breaks it. But Iw ouldnt wnat this to be a thing at all.

Can anyone help to fix it or make a workaround to not have this issue?
 
Sort by date Sort by votes
Maybe the issue is with how the date in Me.DateRange textbox is formatted?
before Me.DateRange value is passed to FindDate it is checked and formatted by this code:
VBA Code: 
Private Sub DateRange_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Dim inputDate As String
    Dim formattedDate As String
    
    ' Get the text that was just entered into the Textbox
    inputDate = Me.DateRange.Value
    
    ' Check if the input is a valid date
    If IsDate(inputDate) Then
        ' If it is, format the date as dd.mm.yyyy
        formattedDate = Format(CDate(inputDate), "dd.mm.yyyy")
        ' Update the Textbox with the formatted date
        Me.DateRange.Value = formattedDate
    Else
        ' If it is not a valid date, show an error message
        MsgBox "Nieprawidłowa data"
        ' Reactivate the Textbox so the user can try again
        Me.DateRange.SetFocus
                ' Select the entire contents of the Textbox
        Me.DateRange.SelStart = 0
        Me.DateRange.SelLength = Len(Me.DateRange.Text)
        Cancel = True
    End If
End Sub
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
any ideas? Maybe someone have an idea how to do it with completely different approach.
 
Upvote 0
I changed the values in ranges D7:J7 so they are no longer formulas (=C4+1, =C4+2 and so on) they are nwo static values put in this cell but it still doesn't work, now when i changed to your given code the cstopped workign entirely.
 
Upvote 0
Still fighting this demon, I tried making sure that all the data is a date, but still the same problems occurs. My code now looks like this:
VBA Code: 
    End If
'find date'
FindDate = CDate(Me.DateRange.Value)
Set dRng = Range("D7:J7")
For a = 0 To 14 'range of 15 arrays of dates
    Set emptyCell = dRng.Find(What:=CDate(FindDate), LookIn:=xlValues, LookAt:=xlWhole)
    If Not emptyCell Is Nothing Then ' check if emptyCell is not nothing
        Dim colNum As Integer
        colNum = emptyCell.Column 'get the column number where the date was found
        For b = emptyCell.Row + 1 To emptyCell.Row + 32 'start the loop from the next row of the found date cell
            If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
                Set emptyCell = Cells(b, colNum)
                ' Add jobtype and hours
                emptyCell.Value = Me.HoursCount.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                Exit For
            End If
        Next b
        Exit For
    Else
        Set dRng = dRng.Offset(60, 0)
    End If
Next a
If emptyCell Is Nothing Then
    MsgBox "No empty cell available below " & dRng.Address
    Exit Sub
End If

I dont believe that excel has such a problem finding date in cells only contatining dates, there has to be some other way of doing this.
Can anyone help?
I'm desperate, I even tried using chatGPT but it was too dumb to find a problem.
 
Upvote 0
I changed the code and it worked yesterday, today it sopped working again, what the hell is wrong with VBA? Here's new code. i discareded loops to create dRng didn't use .find at all, I used simple value comparison, I ahve no idea what so har about this code that keeps making the code break for no apparent reason...
VBA Code: 
'find date'
FindDate = CDate(Me.DateRange.Value)
Set dRng = Range("D7:J7,D67:J67,D127:J127,D187:J187,D247:J247,D307:J307,D367:J367,D427:J427,D487:J487,D547:J547,D607:J607")
Dim emptyCellFound As Boolean 'variable to track if an empty cell has been found
emptyCellFound = False

For Each emptyCell In dRng
    If emptyCell = FindDate Then
        Dim colNum As Integer
        colNum = emptyCell.Column 'get the column number where the date was found
        For b = emptyCell.Row + 1 To emptyCell.Row + 32 'start the loop from the next row of the found date cell
            If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
                Set emptyCell = Cells(b, colNum)
                ' Add jobtype and hours
                emptyCell.Value = Me.HoursCount.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
            End If
        Next b
   
    End If
   
    If emptyCellFound Then 'exit the outer loop if an empty cell has been found
        Exit For
    End If
Next emptyCell
 
Upvote 0
If you use the your code in Post #15 change the highlighted line below to what I have.
Let me know how you go.

Rich (BB code): 
For Each emptyCell In dRng
    If emptyCell.Value2 = CLng(FindDate) Then
        Dim colNum As Integer
 
Upvote 0
Solution
Alex Blakenburg said:
If you use the your code in Post #15 change the highlighted line below to what I have.
Let me know how you go.

Rich (BB code): 
For Each emptyCell In dRng
    If emptyCell.Value2 = CLng(FindDate) Then
        Dim colNum As Integer
Click to expand...
I tried that, first time it didn't change anythign i wnet straigth back to else statement:
If emptyCell Is Nothing Then
MsgBox "No empty cell available below " & dRng.Address
second time i tried ig to an error: 1677848606178.png

on this line: If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
1677848639437.png
I might aswell just for reference place you 2 entire codes depended to each other. It's long, but maybe there sia conflict there that I coudln't find:
VBA Code: 
Private Sub DateRange_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Dim inputDate As String
    Dim formattedDate As String
    
    ' Get the text that was just entered into the Textbox
    inputDate = Me.DateRange.Value
    
    ' Check if the input is a valid date
    If IsDate(inputDate) Then
        ' If it is, format the date as dd.mm.yyyy
        formattedDate = Format(CDate(inputDate), "dd.mm.yyyy")
        ' Update the Textbox with the formatted date
        Me.DateRange.Value = formattedDate
    Else
        ' If it is not a valid date, show an error message
        MsgBox "Nieprawidłowa data"
        ' Reactivate the Textbox so the user can try again
        Me.DateRange.SetFocus
                ' Select the entire contents of the Textbox
        Me.DateRange.SelStart = 0
        Me.DateRange.SelLength = Len(Me.DateRange.Text)
        Cancel = True
    End If
End Sub

Private Sub Submit_Click()
    Dim emp As String
    Dim cell As Range
    Dim i As Integer
    Dim emptyCell As Range
    Dim dRng As Range
    Dim a As Integer, b As Integer
    Dim ans As String
    Dim sheetName As String
    Dim FindDate As Date

    'check if Holiday or Sick is checked'
If Me.Holiday.Value = True And Me.Sick.Value = True Then
    MsgBox "Please select only one checkbox", vbCritical, "Error"
    Exit Sub
End If

'check if Holiday is checked'
If Me.Holiday.Value = True Then
    If Len(Me.DateRange.Value) = 0 Then
        MsgBox "Please enter a Date Range", vbCritical, "Error"
        Exit Sub
    End If
    emp = Me.employee.Value
Set cell = Sheets("MKP_" & emp).Range("A10:A40").Find(What:=CDate(Me.DateRange.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If Not cell Is Nothing Then
        cell.Offset(0, 2).Value = "UW"
    Else
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
    End If
End If


'check if Sick is checked'
If Me.Sick.Value = True Then
    If Len(Me.DateRange.Value) = 0 Then
        MsgBox "Please enter a Date Range", vbCritical, "Error"
        Exit Sub
    End If
    emp = Me.employee.Value

Set cell = Sheets("MKP_" & emp).Range("A10:A40").Find(What:=CDate(Me.DateRange.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If Not cell Is Nothing Then
        cell.Offset(0, 2).Value = "CH"
    Else
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
    End If
End If


'check if either EndedProjectNo combobox or ActiveProjectNo combobox has a value, if yes, determine the sheet to update
    If Not IsEmpty(EndedProjectNo.Value) Or Not IsEmpty(ActiveProjectNo.Value) Then

               
        If Len(Me.ActiveProjectNo.Value) > 5 Then
            Me.EndedProjectNo.Value = ""
            ans = Me.ActiveProjectNo.Value
            sheetName = "Godziny" + Left(ans, 5)
        ElseIf Len(Me.EndedProjectNo.Value) > 5 Then
            ActiveProjectNo.Value = ""
            ans = Me.EndedProjectNo.Value
            sheetName = "Godziny" + Left(ans, 5)
        End If
    End If
'find date'
FindDate = CDate(Me.DateRange.Value)
Set dRng = Range("D7:J7,D67:J67,D127:J127,D187:J187,D247:J247,D307:J307,D367:J367,D427:J427,D487:J487,D547:J547,D607:J607")
Dim emptyCellFound As Boolean 'variable to track if an empty cell has been found
emptyCellFound = False

For Each emptyCell In dRng
    If emptyCell.Value2 = CLng(FindDate) Then
        Dim colNum As Integer 'get the column number where the date was found
        For b = emptyCell.Row + 1 To emptyCell.Row + 32 'start the loop from the next row of the found date cell
            If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
                Set emptyCell = Cells(b, colNum)
                ' Add jobtype and hours
                emptyCell.Value = Me.HoursCount.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
            End If
        Next b
    
    End If
    
    If emptyCellFound Then 'exit the outer loop if an empty cell has been found
        Exit For
    End If
Next emptyCell

If Not emptyCellFound Then 'check if an empty cell was found
    MsgBox "No empty cell available below " & dRng.Address
    Exit Sub
End If
    ' Find next empty cell for JobType2 and HoursCount2
If Len(Me.JobType2.Value) > 0 And Len(Me.HoursCount2.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount2.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType2.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType3 and HoursCount3
If Len(Me.JobType3.Value) > 0 And Len(Me.HoursCount3.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount3.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType3.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType4 and HoursCount4
If Len(Me.JobType4.Value) > 0 And Len(Me.HoursCount4.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount4.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType4.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType5 and HoursCount5
If Len(Me.JobType5.Value) > 0 And Len(Me.HoursCount5.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount5.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType5.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType6 and HoursCount6
If Len(Me.JobType6.Value) > 0 And Len(Me.HoursCount6.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount6.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType6.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
Dim sum As String
Dim curVal As String
Dim looprange As Range

emp = Me.employee.Value
sum = Val(Me.HoursCount.Value) + Val(Me.HoursCount2.Value) + Val(Me.HoursCount3.Value) + Val(Me.HoursCount4.Value) + Val(Me.HoursCount5.Value) + Val(Me.HoursCount6.Value) + Val(Me.GeneralHours.Value) + Val(Me.HoursSpent.Value)
Sheets("MKP_" & emp).Range("A10:A40").Select
Exit Sub
Set looprange = Sheets("MKP_" & emp).Range("A10:A40")
For Each cell In looprange
    If cell.Value = FindDate Then
   
'Set cell = Sheets("MKP_" & emp).Range("A10:A40").Find(What:=CDate(FindDate), LookIn:=xlValues, LookAt:=xlWhole)
    'If Not cell Is Nothing Then
    MsgBox cell.Address
    curVal = Val(cell.Offset(0, 2).Value)
    cell.Offset(0, 2).Value = sum + curVal
Exit For
    Else
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
    End If
Next cell
End Sub
 
Upvote 0
For your 1004 error you don't show what line is highlighted when you hit debug.

For you 2nd error I can't see where you are setting a value for colNum, I would expect a line such as:
colNum = emptyCell.column
before using colNum.
The fact that it made it to line indicates that the .Value2 = CLng(FindDate) has done its job.

You are still using Range.Find in other places. It is very dependent on the find value being formatted in exactly the same manner as what is in the cell.
If you want to continue using Find you could try something like this.
Rich (BB code): 
Set emptyCell = dRng.Find(What:=Format(FindDate, dRng(1).NumberFormat), LookIn:=xlValues, LookAt:=xlPart)
But it assumes that all the date cells are formatted in the same way as the sample cell being used to get the NumberFormat (date format)
 
Upvote 0
mysticmario said:
I tried that, first time it didn't change anythign i wnet straigth back to else statement:
If emptyCell Is Nothing Then
MsgBox "No empty cell available below " & dRng.Address
second time i tried ig to an error:View attachment 86690

on this line: If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
View attachment 86691
I might aswell just for reference place you 2 entire codes depended to each other. It's long, but maybe there sia conflict there that I coudln't find:
VBA Code: 
Private Sub DateRange_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Dim inputDate As String
    Dim formattedDate As String
   
    ' Get the text that was just entered into the Textbox
    inputDate = Me.DateRange.Value
   
    ' Check if the input is a valid date
    If IsDate(inputDate) Then
        ' If it is, format the date as dd.mm.yyyy
        formattedDate = Format(CDate(inputDate), "dd.mm.yyyy")
        ' Update the Textbox with the formatted date
        Me.DateRange.Value = formattedDate
    Else
        ' If it is not a valid date, show an error message
        MsgBox "Nieprawidłowa data"
        ' Reactivate the Textbox so the user can try again
        Me.DateRange.SetFocus
                ' Select the entire contents of the Textbox
        Me.DateRange.SelStart = 0
        Me.DateRange.SelLength = Len(Me.DateRange.Text)
        Cancel = True
    End If
End Sub

Private Sub Submit_Click()
    Dim emp As String
    Dim cell As Range
    Dim i As Integer
    Dim emptyCell As Range
    Dim dRng As Range
    Dim a As Integer, b As Integer
    Dim ans As String
    Dim sheetName As String
    Dim FindDate As Date

    'check if Holiday or Sick is checked'
If Me.Holiday.Value = True And Me.Sick.Value = True Then
    MsgBox "Please select only one checkbox", vbCritical, "Error"
    Exit Sub
End If

'check if Holiday is checked'
If Me.Holiday.Value = True Then
    If Len(Me.DateRange.Value) = 0 Then
        MsgBox "Please enter a Date Range", vbCritical, "Error"
        Exit Sub
    End If
    emp = Me.employee.Value
Set cell = Sheets("MKP_" & emp).Range("A10:A40").Find(What:=CDate(Me.DateRange.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If Not cell Is Nothing Then
        cell.Offset(0, 2).Value = "UW"
    Else
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
    End If
End If


'check if Sick is checked'
If Me.Sick.Value = True Then
    If Len(Me.DateRange.Value) = 0 Then
        MsgBox "Please enter a Date Range", vbCritical, "Error"
        Exit Sub
    End If
    emp = Me.employee.Value

Set cell = Sheets("MKP_" & emp).Range("A10:A40").Find(What:=CDate(Me.DateRange.Value), LookIn:=xlValues, LookAt:=xlWhole)
    If Not cell Is Nothing Then
        cell.Offset(0, 2).Value = "CH"
    Else
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
    End If
End If


'check if either EndedProjectNo combobox or ActiveProjectNo combobox has a value, if yes, determine the sheet to update
    If Not IsEmpty(EndedProjectNo.Value) Or Not IsEmpty(ActiveProjectNo.Value) Then

              
        If Len(Me.ActiveProjectNo.Value) > 5 Then
            Me.EndedProjectNo.Value = ""
            ans = Me.ActiveProjectNo.Value
            sheetName = "Godziny" + Left(ans, 5)
        ElseIf Len(Me.EndedProjectNo.Value) > 5 Then
            ActiveProjectNo.Value = ""
            ans = Me.EndedProjectNo.Value
            sheetName = "Godziny" + Left(ans, 5)
        End If
    End If
'find date'
FindDate = CDate(Me.DateRange.Value)
Set dRng = Range("D7:J7,D67:J67,D127:J127,D187:J187,D247:J247,D307:J307,D367:J367,D427:J427,D487:J487,D547:J547,D607:J607")
Dim emptyCellFound As Boolean 'variable to track if an empty cell has been found
emptyCellFound = False

For Each emptyCell In dRng
    If emptyCell.Value2 = CLng(FindDate) Then
        Dim colNum As Integer 'get the column number where the date was found
        For b = emptyCell.Row + 1 To emptyCell.Row + 32 'start the loop from the next row of the found date cell
            If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
                Set emptyCell = Cells(b, colNum)
                ' Add jobtype and hours
                emptyCell.Value = Me.HoursCount.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
            End If
        Next b
   
    End If
   
    If emptyCellFound Then 'exit the outer loop if an empty cell has been found
        Exit For
    End If
Next emptyCell

If Not emptyCellFound Then 'check if an empty cell was found
    MsgBox "No empty cell available below " & dRng.Address
    Exit Sub
End If
    ' Find next empty cell for JobType2 and HoursCount2
If Len(Me.JobType2.Value) > 0 And Len(Me.HoursCount2.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount2.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType2.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType3 and HoursCount3
If Len(Me.JobType3.Value) > 0 And Len(Me.HoursCount3.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount3.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType3.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType4 and HoursCount4
If Len(Me.JobType4.Value) > 0 And Len(Me.HoursCount4.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount4.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType4.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType5 and HoursCount5
If Len(Me.JobType5.Value) > 0 And Len(Me.HoursCount5.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount5.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType5.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
    'find next emoty cell for JobType6 and HoursCount6
If Len(Me.JobType6.Value) > 0 And Len(Me.HoursCount6.Value) > 0 Then
    For b = emptyCell.Row + 1 To emptyCell.Row + 32
        If Cells(b, dRng.Column).Value = "" Then
            Set emptyCell = Cells(b, dRng.Column)
            ' Add jobtype and hours
            emptyCell.Value = Me.HoursCount6.Value
            Cells(emptyCell.Row, "C").Value = Me.JobType6.Value
            Cells(emptyCell.Row, "B").Value = Me.employee.Value
            Exit For
        End If
        If b = emptyCell.Row + 32 Then
            MsgBox "No empty cell available below " & emptyCell.Address
            Exit Sub
        End If
    Next b
End If
Dim sum As String
Dim curVal As String
Dim looprange As Range

emp = Me.employee.Value
sum = Val(Me.HoursCount.Value) + Val(Me.HoursCount2.Value) + Val(Me.HoursCount3.Value) + Val(Me.HoursCount4.Value) + Val(Me.HoursCount5.Value) + Val(Me.HoursCount6.Value) + Val(Me.GeneralHours.Value) + Val(Me.HoursSpent.Value)
Sheets("MKP_" & emp).Range("A10:A40").Select
Exit Sub
Set looprange = Sheets("MKP_" & emp).Range("A10:A40")
For Each cell In looprange
    If cell.Value = FindDate Then
  
'Set cell = Sheets("MKP_" & emp).Range("A10:A40").Find(What:=CDate(FindDate), LookIn:=xlValues, LookAt:=xlWhole)
    'If Not cell Is Nothing Then
    MsgBox cell.Address
    curVal = Val(cell.Offset(0, 2).Value)
    cell.Offset(0, 2).Value = sum + curVal
Exit For
    Else
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
    End If
Next cell
End Sub
Click to expand...
nevermind... I deleted the lien where colNum was assigned.
 
Upvote 0
Alex Blakenburg said:
For your 1004 error you don't show what line is highlighted when you hit debug.

For you 2nd error I can't see where you are setting a value for colNum, I would expect a line such as:
colNum = emptyCell.column
before using colNum.
The fact that it made it to line indicates that the .Value2 = CLng(FindDate) has done its job.

You are still using Range.Find in other places. It is very dependent on the find value being formatted in exactly the same manner as what is in the cell.
If you want to continue using Find you could try something like this.
Rich (BB code): 
Set emptyCell = dRng.Find(What:=Format(FindDate, dRng(1).NumberFormat), LookIn:=xlValues, LookAt:=xlPart)
But it assumes that all the date cells are formatted in the same way as the sample cell being used to get the NumberFormat (date format)
Click to expand...
The code works fine for now, it worked before so fingers crossed it keeps workign, now I ahve to deal with the later part. I will be runngin thsi code few times now tryign to adjust the rest of the code we'll see it keeps working.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA - Duplicated values after running the loop more than once
Replies
8
Views
441
mysticmario
M
M
  • Question Question
Finding value of textbox in specified range or ranges
Replies
4
Views
415
mysticmario
M
M
  • Solved
VBA Modyfing loop to create a new line on specific conditions
Replies
7
Views
655
dmt32
D
L
  • Solved
VBA Find Cell from Date listed, in Columns, Return cell to highlight in color
Replies
7
Views
458
mumps
mumps
K
  • Question Question
Help Needed
2
Replies
13
Views
291
kwavic
K

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

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