Finding a text string yyyymm based on current year and month

Question

I need to locate all cells within column L starting from Row 10 containing yyyymm+2 (202009). In other words, I'm looking for cells containing all dates belonging to the month 2 months in advance of the current month. Valid values would be 20200901 up until 20200930 accordingly as of July 2020.

The Column L contains values in text format such as 20201120, 20210102, etc. All the values are dates in Column L formatted as text as 'yyyymmdd'.

I'm trying to use the code below, but it is quite clearly wrong, since +2 won't show the correct year or month if the year changes.

Dim strSearchText As String
Dim y As Integer
Dim m As Integer
m = DatePart("mm", Date) + 2
y = DatePart("yyyy", Date)
strSearchText = y & m
Dim rngSearchArea As Range
Set rngSearchArea = ws.Range(Range("L10"), ws.Range("L" & ws.Range("L:L").Cells.Count).End(xlUp))

Any ideas how to solve this?

Answer 1

Maybe you are just looking for something like that? String containing today + 2 months in the yyyydd format:

str = Format(DateAdd("m", 2, Now()), "yyyymm")

Answer 2

Please test the next code. Since you did not answer my above question, it will return the range of processed dates in the column N:N, starting from the tenth row:

Sub GetDateTwoMonthMore()
 Dim sh As Worksheet, arr As Variant, arrF As Variant, lastRow As Long
 Dim El As Variant, k As Long, currMonth As Long
 
  Set sh = ActiveSheet 'use here your sheet
  lastRow = sh.Range("L" & Rows.count).End(xlUp).row
  currMonth = CLng(Month(Date))   'the current month reference
  arr = sh.Range("L10:L" & lastRow).Value 'load the range to be processed in an array
  ReDim arrF(1 To UBound(arr, 1)) 'Redim the final array at the initial dimension of all the range rows
  For Each El In arr
    If CLng(Mid(El, 5, 2)) = currMonth + 2 Then
    'If CLng(Month(El)) = currMonth + 2 Then 'if your cells are date formatted...
        k = k + 1: arrF(k) = El 'fill the final array with the appropriate dates
    End If
  Next
  ReDim Preserve arrF(k) 'Keep only the non empty array elements
  'Drop the array content in the columnn N:N, at once:
  sh.Range("N10").Resize(UBound(arrF)).Value = WorksheetFunction.Transpose(arrF)
End Sub

If your L:L range is Date formatted, you must only comment/delete the line

If CLng(Mid(El, 5, 2)) = currMonth + 2 Then

and un-comment the next one...

Answer 3

Rather than converting and finding the current date into text, it is more accurate to convert the data of cells based on the current date to date data to compare.

Sub testDate()

    Dim y As Integer, y1 As String
    Dim m As Integer, m1 As String, d1 As String
    Dim sDate As Date, eDate As Date
    Dim TargetDay As Date
    Dim rngDB As Range, rng As Range
    Dim Ws As Worksheet
    
    Set Ws = ActiveSheet
    
    y = Year(Date)
    m = Month(Date)
    
    sDate = DateSerial(y, m + 2, 1)
    eDate = DateSerial(y, m + 3, 0) 'Last day
    
    With Ws
        Set rngDB = .Range(Range("L10"), .Range("L" & Rows.Count).End(xlUp))
    End With
    
    For Each rng In rngDB
        y1 = Left(rng, 4)
        m1 = Mid(rng, 5, 2)
        d1 = Right(rng, 2)
        TargetDay = DateSerial(y1, m1, d1)
        If TargetDay >= sDate And TargetDay <= eDate Then
            Debug.Print rng.Address(0, 0, xlA1)
        End If
    Next rng
End Sub