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

[jlive24]

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.

 

[Kamolga]

This is to go through column a, which sheet and to do what?

  [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

 

[Kamolga]

I assume worksheet is same than before, so this one works with sh

[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

 

[Kamolga]

[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

 

[jlive24]

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).

 

[Kamolga]

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

[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

 

[BarryL]

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