Need help with a macro to select all rows with yesterdays date

[Buns1976]

Hi Everyone,

I have a worksheet(Sheet1) with many rows of data that are presorted so that the most current date which is yesterday would start in Row 2(Row 1 is headers).
What I need is a macro that will SELECT ALL rows with yesterdays date([Today()-1]). The number of rows varies. It could be 3 yesterday and 4 today, etc.

From there I will need to copy the SELECTED rows and paste in Cell A1 in Sheet2.
The code below works but only selects the first row with yesterdays date.

Thanks for any help.
D



End Sub

Sub FindYesterdaysDateRow()

Dim Rng     As Range
Dim YesterD As Date

YesterD = DateAdd("d", -1, Date)
Set Rng = Range("A:A").Find(What:=YesterD, LookIn:=xlValues, LookAt:=xlWhole)

Range("A" & Rng.Row & ":V" & Rng.Row).Select

 

[Marc L]

​

Hi, you forgot to reverse the search aka from bottom to top like you can see in Range.Find VBA help …​

​

But do you really need to Select as a good enough VBA procedure does not need it at 99.99% of the times ?​

 

[Buns1976]

​

Hi, you forgot to reverse the search aka from bottom to top like you can see in Range.Find VBA help …​

​

But do you really need to Select as a good enough VBA procedure does not need it at 99.99% of the times ?​

I'm not really sure what you are saying.? Can you show me an example?

 

[JoeMo]

Maybe:

Sub SelectYesterday()
'assumes dates are in col A, starting in A2
Dim dte As Date, Fnd As Range, Adr As String, S As Range
dte = Date - 1
With Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    Set Fnd = .Cells.Find(dte)
    If Not Fnd Is Nothing Then
        Adr = Fnd.Address
        Do
            If S Is Nothing Then
                Set S = Fnd
            Else
                Set S = Union(S, Fnd)
            End If
            Set Fnd = .Cells.FindNext(Fnd)
            If Fnd Is Nothing Or Fnd.Address = Adr Then Exit Do
        Loop
    End If
End With
If Not S Is Nothing Then
    S.EntireRow.Select
Else
    MsgBox "Yesterday's date not found in col A"
End If
End Sub

 

[Marc L]

Can you show me an example?

According to kid level VBA help :​

    Dim Rg As Range
    Set Rg = ActiveSheet.UsedRange.Columns(1).Find(Date - 1, , xlValues, 1, , 2)
     If Rg Is Nothing Then Beep: Exit Sub

 

[Buns1976]

Maybe:

Sub SelectYesterday()
'assumes dates are in col A, starting in A2
Dim dte As Date, Fnd As Range, Adr As String, S As Range
dte = Date - 1
With Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    Set Fnd = .Cells.Find(dte)
    If Not Fnd Is Nothing Then
        Adr = Fnd.Address
        Do
            If S Is Nothing Then
                Set S = Fnd
            Else
                Set S = Union(S, Fnd)
            End If
            Set Fnd = .Cells.FindNext(Fnd)
            If Fnd Is Nothing Or Fnd.Address = Adr Then Exit Do
        Loop
    End If
End With
If Not S Is Nothing Then
    S.EntireRow.Select
Else
    MsgBox "Yesterday's date not found in col A"
End If
End Sub

This worked well. Thank You!

 

[Marc L]

Any loop is useless to find first & last row of a date as that just needs a couple of codelines​

using the Range.Find method just playing with its SearchDirection parameter …​

 

[JoeMo]

This worked well. Thank You!

You are welcome thanks for the reply.

 

[kevin9999]

Your original post said you wanted to copy all the filtered rows to A1 of sheet2? That being the case, please try the following:

Sub CopyYesterday()
    With Sheet1.Range("A1").CurrentRegion
        .AutoFilter 1, 2, 11
        .Offset(1).Resize(.Rows.Count - 1).Copy Sheet2.Range("A1")
        .AutoFilter
    End With
End Sub

 

[Buns1976]

Your original post said you wanted to copy all the filtered rows to A1 of sheet2? That being the case, please try the following:

Sub CopyYesterday()
    With Sheet1.Range("A1").CurrentRegion
        .AutoFilter 1, 2, 11
        .Offset(1).Resize(.Rows.Count - 1).Copy Sheet2.Range("A1")
        .AutoFilter
    End With
End Sub

Hi Kevin,
Thanks for taking the time. Question on this. This does what I need it to but If I change the names on the sheets and in the macro from Sheet1 to SHIFT_IMPORT AND Sheet 2 to SHIFT_EXPORT I am getting a Run-time error of 424. Object required? What would be causing that?