VBA check if cell contains a year - excel

Question

I need a VBA line of code to check if a cell contains a year if this format 199[0-9] OR 20[0-2][0-2].
The code loops from the first row in Column A to the last row in the sheet.
Something like this:
finalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = finalRow To 2 Step -1
If InStr(1, Cells(i, 1), "199[0-9]" OR "20[0-2][0-2]") = 0 Then
Range("A" & i).EntireRow.Delete
End If
I appreciate your cooperation.
Thank You

Answer 1

Consider using the regular expression library to evaluate the year patterns. The object can store the pattern and later evaluate it against the cell values in your loop.
Example:
Option Explicit
Sub example()
' Setup Regular Expression Object
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Pattern = "199[0-9]|20[0-2][0-2]" ' Define pattern here
' Delete rows that match year pattern
Dim i As Integer, ws As Worksheet, finalRow As Integer
Set ws = ThisWorkbook.Worksheets("Sheet1")
finalRow = ws.Range("A1").CurrentRegion.Rows.Count
For i = finalRow To 1 Step -1
If RegEx.test(Cells(i, 1)) Then
ws.Rows(i).EntireRow.Delete
End If
Next i
End Sub

Answer 2

Please, try the next function. It returns all occurrences, if more than one:
Private Function containsYear(x As String) As Variant
Dim regEx As New RegExp, strPattern As String, strInput As String
Dim matchC As MatchCollection, arr() As Long, El, k As Long
strPattern = "([0-9]{4})" 'search for 4 consecutive numbers
If strPattern <> "" Then
strInput = x
With regEx
.Global = True: .MultiLine = True
.IgnoreCase = False: .Pattern = strPattern
End With
If regEx.Test(strInput) Then
Set matchC = regEx.Execute(strInput)
ReDim arr(matchC.count - 1)
For Each El In matchC
If CLng(El) >= 1990 And CLng(El) <= 2022 Then
arr(k) = El: k = k + 1
End If
Next
ReDim Preserve arr(k - 1)
containsYear = arr()
Else
containsYear = Array("no Match")
End If
End If
End Function
It can be checked in this way:
Sub testContainsYear()
Dim x As String, arr() As Long, El
x = "This year, 2021 is better than 2020."
x = "This year, 2021 is better than 1890." 'comment it to check the above line...
arr = containsYear(x)
If UBound(arr) = 0 Then
If arr(0) <> "no Match" Then
Debug.Print "Found a year: " & arr(0)
Else
Debug.Print "No any year could be found..."
End If
Else
For Each El In arr
Debug.Print "Found year " & El
Next
End If
End Sub
If you do not need to return the occurrences, it can return a boolean (True). please, use the next function, in such a case:
Private Function containsYear(x As String) As Boolean
Dim regEx As New RegExp, strPattern As String, strInput As String
Dim matchC As MatchCollection, arr() As Long, El, k As Long
strPattern = "([0-9]{4})" 'search for 4 consecutive numbers
If strPattern <> "" Then
strInput = x
With regEx
.Global = True: .MultiLine = True
.IgnoreCase = False: .Pattern = strPattern
End With
If regEx.Test(strInput) Then
Set matchC = regEx.Execute(strInput)
ReDim arr(matchC.count - 1)
For Each El In matchC
If CLng(El) >= 1990 And CLng(El) <= 2022 Then
containsYear = True: Exit Function
End If
Next
Else
containsYear = False
End If
End If
End Function
It can be tested as:
Sub testContainsYear()
Dim x As String, arr() As Long, El
x = "This year, 2021 is better than 2020."
x = "This year, 1542 was better than 1890." 'comment it to check the above line...
Debug.Print containsYear(x)
End Sub
To use the function for processing the existing values in A:A column, should be simple. Declare a range variable rngDel where to keep cells when the function returns True. Firstly, set the range, then using Union and delete all rows at the end (`If Not rngDel Is Nothing Then rngDel.EntireRow.Delete'). If not clear enough, I can help with the code, too.