Copying rows that contain todays date

[slora00]

Hello Community, I hope you're all doing great.

I need a VBA code to copy the range B:R from "Sales" sheet onto "Report" sheet based on the condition of only selecting those rows that contain today's date on column B.

Please help me as you can.

 

[SQUIDD]

Hello Community, I hope you're all doing great.

I need a VBA code to copy the range B:R from "Sales" sheet onto "Report" sheet based on the condition of only selecting those rows that contain today's date on column B.

Please help me as you can.

So, would it work for you if

1, apply a filter to your data on sales, for column B looking for todays date.
2, copy the filtered data.
3, paste the filtered data into sheet Report.
4, un_filter your sales sheet.

?

Dave

 

[SQUIDD]

This should work for you, but my previous method would be faster i expect.

you may need to tweak paste positions, not sure if you have headers etc, have assumed your sales sheet has headers and data starts in row 2.

Sub GET_TODAY()
Application.ScreenUpdating = False
For A = 2 To Range("'Sales'!B" & Rows.Count).End(xlUp).Row
    If Range("'Sales'!B" & A) = Date Then
        Range("'Sales'!B" & A & ":R" & A).Copy
        Range("'Report'!A" & Range("'Report'!A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlValues
    End If
Next A
Sheets("Report").Activate
Application.ScreenUpdating = True
End Sub

 

[slora00]

So, would it work for you if

1, apply a filter to your data on sales, for column B looking for todays date.
2, copy the filtered data.
3, paste the filtered data into sheet Report.
4, un_filter your sales sheet.

?

Dave

Yes, that would work, but my Sales sheet has more days data separated by a blank row each. For example, 5 rows for 11/8/2022, a blank row, then 5 rows for 11/9/2022, a blank row, so on so on. So before filtering, I would need to delete those blank rows, then filter by today's date.

 

[slora00]

This should work for you, but my previous method would be faster i expect.

you may need to tweak paste positions, not sure if you have headers etc, have assumed your sales sheet has headers and data starts in row 2.

Sub GET_TODAY()
Application.ScreenUpdating = False
For A = 2 To Range("'Sales'!B" & Rows.Count).End(xlUp).Row
    If Range("'Sales'!B" & A) = Date Then
        Range("'Sales'!B" & A & ":R" & A).Copy
        Range("'Report'!A" & Range("'Report'!A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlValues
    End If
Next A
Sheets("Report").Activate
Application.ScreenUpdating = True
End Sub

Thank you! This worked perfectly!

 

[SQUIDD]

Thank you! This worked perfectly!

Ok great. I’d suggest just using that then. With the blank cells. This code accounts for that. Thanks for the feedback

 

[slora00]

Ok great. I’d suggest just using that then. With the blank cells. This code accounts for that. Thanks for the feedback

Hey man, I hope you're doing great. I've been using the code you made since you posted it here, but there's something I'd like to change, If you may help me.

On my first request the range was B:R, but know I need to copy the range AD:AG of the rows that contain today's date (stated on column B). I know it's the same code you already did, but I just don't know what part do I need to change so I can copy my desired range (AD:AG).

Greetings!

 

[SQUIDD]

Hi

So have written the code differently, so hopefully you understand the process a little better.
code below

Sub GET_TODAY()
Application.ScreenUpdating = False

LAST_ROW_OF_DATA_IN_A_COLUMN = Range("'Sales'!B" & Rows.Count).End(xlUp).Row 'THIS FINDS THE LAST ROW IN COLUMN B

For ROW_NUMBER = 2 To LAST_ROW_OF_DATA_IN_A_COLUMN 'THIS IS THE LOOP THAT WILL CEHCK EVERY ROW FROM 2 TO LAST ROW, ASSUMING YOUR DATA HAS HEADERS
    If Range("'Sales'!B" & ROW_NUMBER) = Date Then 'CHECKS IF COLUMN B ON THIS PARTICULAR LOOP IS TODAYS DATE
        Range("'Sales'!B" & ROW_NUMBER & ":R" & ROW_NUMBER).Copy 'COPIES THE RANGE FROM B TO R ON THIS PARTICULAR ROW NUMBER OF THE LOOP
        PASTE_ROW = Range("'Report'!A" & Rows.Count).End(xlUp).Row + 1 'DETERMINES WHERE TO PASTE THE DATA ON YOUR REPORT SHEET
        Range("'Report'!A" & PASTE_ROW).PasteSpecial xlValues 'PASTES THE DATA ON REQUIRED LOCATION
    End If
Next A
Sheets("Report").Activate
Application.ScreenUpdating = True
End Sub

so to change this, see below the code changed.

Sub GET_TODAY()
Application.ScreenUpdating = False

LAST_ROW_OF_DATA_IN_A_COLUMN = Range("'Sales'!B" & Rows.Count).End(xlUp).Row

For ROW_NUMBER = 2 To LAST_ROW_OF_DATA_IN_A_COLUMN
    If Range("'Sales'!B" & ROW_NUMBER) = Date Then
        Range("'Sales'!AD" & ROW_NUMBER & ":AG" & ROW_NUMBER).Copy 'CHANGED TO AD AND AG
        PASTE_ROW = Range("'Report'!A" & Rows.Count).End(xlUp).Row + 1
        Range("'Report'!A" & PASTE_ROW).PasteSpecial xlValues
    End If
Next A

Sheets("Report").Activate
Application.ScreenUpdating = True
End Sub

Hope that makes more sense so you can manipulate and change easily yourself.

Dave