Forum Discussion

JamesPhImp's avatar
JamesPhImp
Copper Contributor
Aug 03, 2023

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

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.

  • SnowMan55's avatar
    SnowMan55
    Bronze Contributor

    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.

Resources