Copy a row based on a date value

[Needinghlp]

Hi all,

Hoping someone might be able to offer some guidance. I have 2 worksheets (sheet1 & sheet2). Sheet 2 contains a list of dates in column O.
I am trying to create some code that will identify dates after 30/06/2021 on sheet2, copy the relevant row and paste it to sheet1.
Below is the code I have. I've also tried putting 30/06/2021 in a reference cell (BB1) and used this line of code instead of whats below, but that doesn't work either: If Worksheets("Sheet2").Cells(i, 15).Value > ("BB1") Then

Private Sub CommandButton10_Click()

A = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To A

If Worksheets("Sheet2").Cells(i, 15).Value > 30 / 6 / 2021 Then

Worksheets("Sheet2").Rows(i).Copy
Worksheets("Sheet1").Activate
b = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet1").Cells(b + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues

End If

Next

End Sub

 

[mohadin]

Hi
Try

If Worksheets("Sheet2").Cells(i, 15).Value > "30 / 6 / 2021" Then

 

[EXCEL MAX]

Try this...

Private Sub CommandButton10_Click()

    A = Worksheets("Sheet2").Cells(Rows.Count, 15).End(xlUp).Row
    B = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To A
        If Worksheets("Sheet2").Cells(i, 15).Value > _
            Sheets("Sheet2").Range("B1").Value Then
            Worksheets("Sheet2").Rows(i).EntireRow.Copy
            B = B + 1
            Worksheets("Sheet1").Cells(B, 1) _
                .PasteSpecial xlPasteValues
        End If
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

 

[Needinghlp]

Hi
Try

If Worksheets("Sheet2").Cells(i, 15).Value > "30 / 6 / 2021" Then

Thank you and I think this is one version I had tried, but for some reason it still returns values including 5/04/2021 & 4/01/2021

 

[mohadin]

Would you try

If DateValue(Worksheets("sheet2").Cells(i, 15)) > DateValue("30/06/2021") Then

 

[Needinghlp]

Try this...

Private Sub CommandButton10_Click()

    A = Worksheets("Sheet2").Cells(Rows.Count, 15).End(xlUp).Row
    B = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To A
        If Worksheets("Sheet2").Cells(i, 15).Value > _
            Sheets("Sheet2").Range("B1").Value Then
            Worksheets("Sheet2").Rows(i).EntireRow.Copy
            B = B + 1
            Worksheets("Sheet1").Cells(B, 1) _
                .PasteSpecial xlPasteValues
        End If
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Unfortunately this isn't quite working either. Can I confirm is Range("B1") meant to be the cell where I have 30/06/2021 entered? I've actually got it entered in BB1 - but I've tried both BB1 and B1 and neither work. Both BB1 and B1 transfers nothing and B1

Would you try

If DateValue(Worksheets("sheet2").Cells(i, 15)) > DateValue("30/06/2021") Then

I thought this was going to be the answer, but I get a Run-time error '13' Type mismatch? I feel like it's so close, but I just can't crack it.

 

[mohadin]

All right
Tested

If Worksheets("Sheet2").Cells(i, 15) > DateValue("30/6/2021") Then

 

[EXCEL MAX]

My mistake, should be "BB1".
Set format of cell "BB1" and columns "O" to date before entering dates.

 

[vcoolio]

Hello Needinghlp,

Another option is to use the Autofilter:-

Private Sub CommandButton10_Click()

        Dim pDt As Long: pDt = Sheet2.[BB1].Value
        
Application.ScreenUpdating = False

        With Sheet2.Range("O2", Sheet2.Range("O" & Sheet2.Rows.Count).End(xlUp))
                .AutoFilter 1, ">" & pDt
                .Offset(1).EntireRow.Copy
                Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
                .AutoFilter
        End With
        
Application.ScreenUpdating = True

End Sub

I've assumed:-
- You have headings in Row2 of Sheet2.
- The reference cell (BB1) is in Sheet2 as well.

You'll need to format Column O in Sheet1 as Date.

I hope that this helps.

Cheerio,
vcoolio.

 

[Needinghlp]

Hello Needinghlp,

Another option is to use the Autofilter:-

Private Sub CommandButton10_Click()

        Dim pDt As Long: pDt = Sheet2.[BB1].Value
       
Application.ScreenUpdating = False

        With Sheet2.Range("O2", Sheet2.Range("O" & Sheet2.Rows.Count).End(xlUp))
                .AutoFilter 1, ">" & pDt
                .Offset(1).EntireRow.Copy
                Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
                .AutoFilter
        End With
       
Application.ScreenUpdating = True

End Sub

I've assumed:-
- You have headings in Row2 of Sheet2.
- The reference cell (BB1) is in Sheet2 as well.

You'll need to format Column O in Sheet1 as Date.

I hope that this helps.

Cheerio,
vcoolio.

Hi vcoolio - I just wanted to let you know this worked a treat - big thank you!! I did make a few small adjustments, for example when referencing the worksheets I had to do it like Worksheets("Sheet2"). I also encountered an error with the application.screenupdating = true so I deleted those lines.