VBA to select rows before today's date and paste as values

jlive24

New Member
Joined
Dec 18, 2018
Messages
5
I have a workbook that is used daily to keep track of new data coming in each day. The "Summary" sheet uses formulas determine the day and then pull relevant data from other sheets in the workbook to track historical data, going all the way back to 2016. To prevent the formulas from slowing down the workbook, every few weeks I go into the historical sheet and paste as values all rows before tomorrow's date, so that only future dates remain as formula.

Instead of doing this, I would like to be able to use a script that will search either 1) Column A to find today's date or 2) find the last row between columns A and L that contains data (not just formula), and then copy and paste that row (between columns A and L) as values over itself.

If possible I would also like a script similar to this, but that would delete all rows (minus the header) on the "History" sheet that contain a date before today's date in column BW.

For reference, on both sheets new days are added at the bottom, with the earliest dates starting in Row 2.
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
This is to go through column a, which sheet and to do what?
Code:
  [COLOR=#008000]'1)search Column A to find today's date[/COLOR]
        Dim LookCell As Range
        [COLOR=#008000]'On which sheet? Please adapt Sheet1 in line below[/COLOR]
         Dim sh As Worksheet: Set sh = Worksheets("[COLOR=#0000ff]Sheet1[/COLOR]")
       [COLOR=#008000] 'Last Row column A[/COLOR]
         Dim lr As Long: lr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
         For Each LookCell In Range("A1:A" & lr)
            If LookCell = DateSerial(Year:=Year(Now), Month:=Month(Now), Day:=Day(Now)) Then
            [COLOR=#ff0000]'what you want to do with this cell/row? Put the code here below[/COLOR]
            
            End If
         Next LookCell
 
Upvote 0
I assume worksheet is same than before, so this one works with sh
Code:
[COLOR=#008000]'2) find the last row between columns A and L that contains data (not just formula)[/COLOR]
         Dim lrAL As Long
         lrAL = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
         Dim i As Long
         For i = 2 To 12
            If sh.Cells(sh.Rows.Count, i).End(xlUp).Row > lrAL Then
               lrAL = sh.Cells(sh.Rows.Count, i).End(xlUp).Row
            End If
         Next i
      [COLOR=#008000]   ' copy and paste that row (between columns A and L) as values over itself.[/COLOR]
            Range("A" & lrAL & ":L" & lrAL).Copy
            Range("A" & lrAL & ":L" & lrAL).PasteSpecial Paste:=xlPasteValues
 
Last edited:
Upvote 0
Code:
[COLOR=#008000] '3) delete all rows on the "History" sheet that contain a date before today's date in column BW.
         'Last row Bw[/COLOR]
         Dim ws As Worksheet: Set ws = Worksheets("History")
         Dim lrBW As Long: lrBW = ws.Cells(ws.Rows.Count, "BW").End(xlUp).Row
         ws.Select
         Dim dCell As Range
         For Each dCell In ws.Range("BW2:BW" & lrBW)
            If (dCell.Value < DateSerial(Year:=Year(Now), Month:=Month(Now), Day:=Day(Now)) And dCell <> "") Then
               dCell.EntireRow.Delete
            End If
         Next dCell
 
Last edited:
Upvote 0
The deletion vba works great, but there seems to be an issue with steps 1 and 2. For some reason the script doesn't paste over the row with today's date (in this case that would be row 513), but instead seems to paste a blank row in row 659. In case it matters, each time the workbook is opened on a new day, a new row will appear (there are formulas down to row 658, so tomorrow row A514 will be read 12/19/18 instead of being blank).
 
Upvote 0
I am not sure to understand what you try to do. The code below mixes both: It looks on a sheet called History (you can change it) for the last cell containing today's date in its A column. When it finds it, it selects A to L of that row and copy-paste their values. Hope this is what you are looking for

Code:
[COLOR=#008000]'1)search Column A to find last occurence of today's date[/COLOR]
        [COLOR=#008000]'On sheet called History[/COLOR]
         Dim sh As Worksheet: Set sh = Worksheets("[COLOR=#0000ff]History[/COLOR]")
        [COLOR=#008000]'Last Row column A[/COLOR]
         Dim lr As Long: lr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
  [COLOR=#008000]      'Today's date[/COLOR]
         Dim tDate As Date: tDate = DateSerial(Year:=Year(Now), Month:=Month(Now), Day:=Day(Now))
       [COLOR=#008000] 'Last occururence of today value in Column A, the cell is called dCell[/COLOR]
            Dim dcell As Range: Set dcell = sh.Range("A1:A" & lr).Find(tDate, , , , , searchdirection:=xlPrevious)
       [COLOR=#008000] 'Copy-paste value of last occurence row (column A to L)[/COLOR]
        Range("A" & dcell.Row & ":L" & dcell.Row).Copy
        Range("A" & dcell.Row & ":L" & dcell.Row).PasteSpecial Paste:=xlPasteValues
 
Last edited:
Upvote 0
firstly, "History" is a reserved name so not sure how you can have a sheet named this?

secondly, are column A's data formulas or constants? if the formulas are dragged down past the point of the meaningful data Kamolga's last row code will give the incorrect row number
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top