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

 

[Eric Penfold]

Thanks very much works like a dream.

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.