Forum Discussion
JamesPhImp
Aug 03, 2023Copper Contributor
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.
- SnowMan55Bronze 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.
Are the dates sorted in ascending (or descending) order?
If not, would it be OK to sort the data on the date column?