VBA code for finding date sometimes doesn't work.

[mysticmario]

Hi, I have this bit of 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?

 

[Alex Blakenburg]

What stopped working ?

 

[mysticmario]

'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
        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

If Not emptyCellFound Then 'check if an empty cell was found
    MsgBox "No empty cell available below " & dRng.Address
    Exit Sub
End If

 

[Alex Blakenburg]

Is dRng on the same sheet that your button is on ?
When it didn't work did you use the button or run it directly from VBA.
If it was working before and not now it is most likely a data issue either with the date input or the data on the sheet.

 

[mysticmario]

Ok i made some test, the button is not on the same sheet as dRng and if I run the code from that button it doesnt work,
but If i run the code from VBA window on that sheet it works fine.
I added sheet activation before find date code and it works.
Now onto the second problem.

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).Activate 'added this a minute ago to anologicaly to 'find date' to try to solve the issue of the date not being found and it didnt help'

Set looprange = Sheets("MKP_" & emp).Range("A10:A40")
For Each cell In looprange
    If CLng(cell.Value2) = CLng(FindDate) Then
   MsgBox "we're gucci"
   Exit Sub
'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

 

[Alex Blakenburg]

Did you try adding the debug code I gave you ?

 

[mysticmario]

Did you try adding the debug code I gave you ?

debug print :

Looks liek the findDate is ok 20.002 the rest unfortunately is not

 

[Alex Blakenburg]

Based on your previous image you would need to loop through 20 times to get to that find date in column A.
I suggest you enter a date that is closer to the top for the initial testing and step through the required number of loops.

 

[mysticmario]

Based on your previous image you would need to loop through 20 times to get to that find date in column A.
I suggest you enter a date that is closer to the top for the initial testing and step through the required number of loops.

It doesnt loop at all, it goies straigth to
Else
MsgBox "Update MKP with current dates", vbCritical, "Error"
Exit Sub
End If
Next cell
End sub
@edit
I tried usign 01.02.2023 and it found, so why does it nto find later dates?
After that i typed in as a second test 02.02.2023 and it didnt find it.

 

[Alex Blakenburg]

Get rid of the "exit sub"

If the date only appears once you might be better off using application.match instead of a loop.

 

[mysticmario]

code works only for 01.02.2023 nothing else, on top of that it stopped adding the value to each other but make them into a string so if I add 3 times for 1hour i get 111 instead of 3