VBA code for finding date sometimes doesn't work.

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?
 
u 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)
I'm gonna try to rewrite now, cause I never liked the Range.Find it alwasy goes bad sooner or later.
 
Upvote 0

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Yes, Range.Find seems pretty temperamental when it comes to dates.
Just make sure you use Value2 when reading dates from a cell and if you've used CDate to convert a text date use CLng after that and it should be in the same format as your Value2 from the Cell.
 
Upvote 0
BTW, I tried to apply thw same solution for the last part of the code but it didn't work:
VBA Code:
Set looprange = Sheets("MKP_" & emp).Range("A10:A40")
For Each cell In looprange
    If 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
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
    End If
Next cell
End Sub
 
Upvote 0
Can you talk me through as to what "didn't work" means.
You have an "Exit Sub" after the 1st Message box, so if it finds the date it should show the message box then terminate.

If it is not finding the date then you need to show us what is in Sheets("MKP_" & emp).Range("A10:A40")
 
Upvote 0
Can you talk me through as to what "didn't work" means.
You have an "Exit Sub" after the 1st Message box, so if it finds the date it should show the message box then terminate.

If it is not finding the date then you need to show us what is in Sheets("MKP_" & emp).Range("A10:A40")
So it simply doesnt find the date. I checked and when I MsgBox Sheets("MKP_" & emp).Range("A10:A40").address
I get a proper range as result, so it found the sheet and the range.
variable emp = "employee"
I use msgbox and exit sub to test things, i delete it when the bit of code is checked and working. In thsic ase even if I go line by line by F8 it just goes straight to
VBA Code:
Else
        MsgBox "Update MKP with current dates", vbCritical, "Error"
        Exit Sub
 
Upvote 0
Its quite late here and I am about to log off. Can you provide an XL2BB of Sheets("MKP_" & emp).Range("A10:A40") or if not at least an image.
Alternative a sample of the workbook via Dropbox, Google drive etc and I will have a look tomorrow.
 
Upvote 0
The workbook is massive, Sheets("MKP_" & emp).Range("A10:A40") is quite simple wtih no macros. column A has dates to match, B has weekdays, C has hours count, where sum of horus from previous sheet should be placed and D has just some comments section and that's it.
1677938228813.png
 
Upvote 0
Just trying the easy one first.
Can you try adding CLng to the other side as well ie
Rich (BB code):
    If CLng(cell.Value2) = CLng(FindDate) Then

Next if that doesn't work, if you change the format of Column A eg different date format or number format or general, does the displayed date value change (if it changes it is being recognised as a number, if not it is text)

If that doesn't work do you want to try and put something like the below "before" the If statement.
Pick a date that is going to appear early in your column A and see if what prints to the immediate window makes sense.

VBA Code:
    Debug.Print "If Cell = FindDate:" & CLng(cell.Value2) = CLng(FindDate) & Chr(10) & _
                "Cell Address: " & cell.Address(External:=True) & Chr(10) & _
                "Cell Value: " & cell.Value & "   Number: " & cell.Value2 & Chr(10) & _
                "FindDate: " & FindDate & "  CLng(FindDate): " & CLng(FindDate)
 
Upvote 0
Just trying the easy one first.
Can you try adding CLng to the other side as well ie
Rich (BB code):
    If CLng(cell.Value2) = CLng(FindDate) Then

Next if that doesn't work, if you change the format of Column A eg different date format or number format or general, does the displayed date value change (if it changes it is being recognised as a number, if not it is text)

If that doesn't work do you want to try and put something like the below "before" the If statement.
Pick a date that is going to appear early in your column A and see if what prints to the immediate window makes sense.

VBA Code:
    Debug.Print "If Cell = FindDate:" & CLng(cell.Value2) = CLng(FindDate) & Chr(10) & _
                "Cell Address: " & cell.Address(External:=True) & Chr(10) & _
                "Cell Value: " & cell.Value & "   Number: " & cell.Value2 & Chr(10) & _
                "FindDate: " & FindDate & "  CLng(FindDate): " & CLng(FindDate)
Unfrotunately I cant try this code, cause again the first part of the code stopped working... I dont get excel, I've beeing tryin yo fix this issue for a week straight. Sometimes I wodner didnt I spent my tiem elarnign different lnaguage, casue all I get is error afetr error after error on good code...
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

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