VBA to check the date in column A, if its more than 40 days in the past then hardcode that line

Copper Contributor

Hi,

I have a spreadsheet and would like a VBA code that checks the date that will be in column A, if the value of that date is older than 40days then it hardcodes that entire row (ie removes formulas and keeps the values), albeit there is only data is columns A:Z. I have about 10k+ lines to go through so something fairly efficient would be great! Thanks for help.

2 Replies

@JamesPhImp 

Are the dates sorted in ascending (or descending) order?

If not, would it be OK to sort the data on the date column?

@JamesPhImp Consider the following procedure/macro.

Sub ConvertFormulasToValues()

    Const strTITLE = "Convert Formulas to Values"
    Const in4AGE_OF_OLDEST_FORMULAS As Long = 40
    
    Dim objWksht    As Worksheet
    Dim in4Row      As Long
    Dim in4Col      As Long
    Dim rngCell     As Range
    Dim vntCellValue    As Variant
    Dim in4AgeOfRow As Long 'as calculated from column A
    '
    Dim in4RowsModified As Long 'a count
    
    '   For communicating with the user:
    Dim strMessage  As String
    Dim in4UserResponse As VbMsgBoxResult
    
    '----   Capture a reference to the worksheet to be modified.
    Set objWksht = ActiveSheet
    '  --   Get confirmation from the user that this is the desired sheet.
    strMessage = "Are you CERTAIN that you want to convert formulas" _
            & " in worksheet " & objWksht.Name & " to values (for rows" _
            & " with data more than " & in4AGE_OF_OLDEST_FORMULAS _
            & " days old)?"
    in4UserResponse = MsgBox(strMessage, vbQuestion Or vbYesNo Or vbDefaultButton2 _
            , strTITLE)
    If in4UserResponse = vbNo Then Exit Sub
    
    '----   Modify the rows with old data in that worksheet.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    '  --   Loop through all rows (from top to bottom, though the order
    '       is presumably not important).
    With objWksht
        For in4Row = 1 To .UsedRange.Rows.Count
            '   Column A contains the controlling date.
            Set rngCell = .Range("A" & in4Row)
            vntCellValue = rngCell.Value
            If IsEmpty(vntCellValue) Then GoTo NextRow
            If Not IsDate(vntCellValue) Then GoTo NextRow
            '   Check the data's age.
            in4AgeOfRow = Date - vntCellValue
            If in4AgeOfRow <= in4AGE_OF_OLDEST_FORMULAS Then
                GoTo NextRow
            End If
            '   Modify cells in this row.
            For in4Col = 1 To 26    'A-to-Z
                Set rngCell = .Cells(in4Row, in4Col)
                With rngCell
                    If IsEmpty(.Formula) _
                    And IsEmpty(.Formula2) Then
                        '...skip this cell.
                    Else
                        '(Could include more code here to distinguish
                        'between formulas and values, but that seems
                        'not worthwhile.)
                        .Value = .Value
                    End If
                End With
            Next in4Col
            in4RowsModified = in4RowsModified + 1
NextRow:
        Next in4Row
    End With
    '  --
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    '----   Display a summary, and exit.
    strMessage = Format$(in4RowsModified, "#,###,###,##0") _
            & " rows were modified."
    Call MsgBox(strMessage, vbInformation Or vbOKOnly, strTITLE)
    '
    Exit Sub

End Sub

 I tested it on only a couple dozen rows, but expect that the performance is satisfactory.