Please help me to find the date in my code

[Eric Penfold]

The below code needs to find the specified date but it won`t? Please help it is sending me nuts

        With Rng
       
        Set D = .Find(What:=YDat, LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)

Sub BOReason()

    Dim Ws             As Worksheet
    Dim LRow           As Long
    Dim x              As Variant, y As Variant, i As Variant
    Dim Rng            As Range, Comparerng As Range, D As Range
    Dim YDat           As Date
    Dim TDat           As Date
    Dim LWorkingDay    As Date
    Dim StartTime      As Double
    Dim SecondsElapsed As Double
   
    StartTime = Timer
   
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With

       

        Set Ws = ActiveSheet
        LRow = Ws.Range("A1").End(xlDown).Row
        Set Rng = Ws.Range("A1" & LRow)
        YDat = Format(CDate(Application.WorksheetFunction.WorkDay(Date, -1)), "dd/mm/yyyy")
        TDat = CDate(Date)
       
        With Rng
       
        Set D = .Find(What:=YDat, LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
       
        If Not D Is Nothing Then
        Do
        Set D = .FindNext(D)
        Loop While Not D Is Nothing
        .AutoFilter 1, Format(TDat, "dd/mm/yyyy"), 2, Format(YDat, "dd/mm/yyyy")
        ElseIf D Is Nothing Then
        .AutoFilter 1, Format(TDat, "dd/mm/yyyy")
        End If
       
        End With

          If Ws.Name <> "Summary" And Ws.Name <> "Trend" And Ws.Name <> "Supplier BO" And Ws.Name <> "Dif Depot" Then

            Set Comparerng = .Range("E2:E" & LRow)

                 For Each x In Comparerng.SpecialCells(xlCellTypeVisible)
                For Each y In Comparerng.SpecialCells(xlCellTypeVisible)

                       If x = y Then
                            .Range("J" & y.Row) = .Range("J" & x.Row)
                        End If
                    Next y
               Next x
            End If

        .Range("AA1") = ""
        End With
.
    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With


    Ws.ShowAllData

SecondsElapsed = Round(Timer - StartTime, 2)

MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

 

[bebo021999]

With this

YDat = Format(CDate(Application.WorksheetFunction.WorkDay(Date, -1)), "dd/mm/yyyy")

YDat is text string

With this:

Set D = .Find(What:=YDat, LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)

is searching text-string (like "23/06/2022") in rng (column A)

Make sure column A contains date in text-string, not date value.

 

[Eric Penfold]

Thanks but now the D dim says runtime error 91?
Please help

 

[Alex Blakenburg]

Which line is highlighted when you hit debug after the error ?

 

[Eric Penfold]

Please don`t worry I`ve rewrote the code seems to work now.

 

[Alex Blakenburg]

OK Thanks for letting us know. If you want to post what you did to fix your original issue, you can mark your own comment as a solution and it may help others with a similar issue.

 

[Eric Penfold]

Here you go

Sub BOReason()

    Dim Ws             As Worksheet
    Dim LRow           As Long
    Dim x              As Variant, y As Variant, i As Variant, Dat As Variant
    Dim Rng            As Range, Comparerng As Range
    Dim YDat           As Date
    Dim TDat           As Date
    Dim LWorkingDay    As Date
    Dim StartTime      As Double
    Dim SecondsElapsed As Double
   
    StartTime = Timer
   
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With

       

        Set Ws = ActiveSheet
        LRow = Ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        YDat = Format(CDate(Application.WorksheetFunction.WorkDay(Date, -1)), "dd/mm/yyyy")
        TDat = CDate(Date)
        Dat = YDat
        
        On Error Resume Next
            For Each Dat In Ws.Range("A2:A" & LRow)
            Set Rng = Ws.Range("A2:A" & LRow).Find(YDat, LookIn:=xlValues, LookAt:=xlWhole)
            Next Dat
        
        With Rng
             If Rng Is Nothing Then
                .AutoFilter 1, Format(TDat, "dd/mm/yyyy")
            Else
                .AutoFilter 1, Format(TDat, "dd/mm/yyyy"), 2, Format(YDat, "dd/mm/yyyy")
             End If
             End With
        
        With Ws
          If Ws.Name <> "Summary" And Ws.Name <> "Trend" And Ws.Name <> "Supplier BO" And Ws.Name <> "Dif Depot" Then

            Set Comparerng = .Range("E2:E" & LRow)

                 For Each x In Comparerng.SpecialCells(xlCellTypeVisible)
                For Each y In Comparerng.SpecialCells(xlCellTypeVisible)

                       If x = y Then
                            .Range("J" & y.Row) = .Range("J" & x.Row)
                        End If
                    Next y
               Next x
            End If

        .Range("AA1") = ""
        End With

    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With


    Ws.ShowAllData

SecondsElapsed = Round(Timer - StartTime, 2)

MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

 

[Alex Blakenburg]

I don't whether to leave it alone because it is working for you but just in case you want to know.

This line doesn't do anything:

Dat = YDat

Even if it did serve a purpose it is overwritten by this:

For Each Dat In Ws.Range("A2:A" & LRow)

But then there is nothing in the following line that changes as you loop through the cells

Set Rng = Ws.Range("A2:A" & LRow).Find(YDat, LookIn:=xlValues, LookAt:=xlWhole)

So there it really no benefit to have that inside that For loop.

 

[Eric Penfold]

Ok, Do it how you think it should be please then send it to me. I admit I am still learning VBA so it would help me to understand coding better

 

[Alex Blakenburg]

The first 2 lines are just for context.

But you should be able to replace this:

        YDat = Format(CDate(Application.WorksheetFunction.WorkDay(Date, -1)), "dd/mm/yyyy")
        TDat = CDate(Date)
        Dat = YDat
        
        On Error Resume Next
            For Each Dat In Ws.Range("A2:A" & LRow)
            Set Rng = Ws.Range("A2:A" & LRow).Find(YDat, LookIn:=xlValues, LookAt:=xlWhole)
            Next Dat

With the below and still get the same result.

        YDat = Format(CDate(Application.WorksheetFunction.WorkDay(Date, -1)), "dd/mm/yyyy")
        TDat = CDate(Date)

        On Error Resume Next
            Set Rng = Ws.Range("A2:A" & LRow).Find(YDat, LookIn:=xlValues, LookAt:=xlWhole)