Select every cell plus 2 above in column AA, containing one of these values

[yits05]

Hello,

I am a bit stumped trying to code some VBA to do the following:

1. Scan column AA (length varies day-to-day) for any cell containing any of the following strings: January, February, March, April, May, June, July, August, September, October, November, December
2. When found, select the cell in which the string was found, PLUS the two cells directly on top of it.

I appreciate any help!

 

[LazyBug]

If it's still valid. It might come in handy for somebody.

Sub yits()
Dim r1 As Range, r2 As Range, i As Long
Dim arrM(), m As Long
    arrM = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")

Set r1 = Application.Range(ActiveSheet.Range("AA2"), ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)) 'amend AA2 to the column with months top cell address
    For i = 1 To r1.Rows.Count
        For m = LBound(arrM) To UBound(arrM)
            If r1.Cells(i, 1) = arrM(m) Then
                If r2 Is Nothing Then
                    Set r2 = r1.Cells(i, 1)(-1, 1).Resize(3, 1)
                Else
                    Set r2 = Application.Union(r2, r1.Cells(i, 1)(-1, 1).Resize(3, 1))
                End If
            End If
        Next m
    Next i
r2.Select
End Sub

 

[jolivanes]

@ LazyBug

arrM = Application.GetCustomListContents(4)

 

[LazyBug]

@ LazyBug

arrM = Application.GetCustomListContents(4)

Good clarification! I didn't know that, thank you.

 

[Peter_SSs]

Assuming ..
- that there is a header row and
- that a month name will not appear in row 2 and
- any month names appear as the only text in the cells
.. this would require a lot less looping both through cells and through month names.

Sub yits_v2()
  Dim rA As Range, r2 As Range, rMonths As Range
 
  With Range("AA1", Range("AA" & Rows.Count).End(xlUp))
    .AutoFilter Field:=1, Criteria1:=Application.GetCustomListContents(4), Operator:=xlFilterValues
    If .SpecialCells(xlVisible).Count > 1 Then
      Set rMonths = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible)
    End If
    .AutoFilter
    If Not rMonths Is Nothing Then
      Set r2 = Range("A1")
      For Each rA In rMonths.Areas
        Set r2 = Union(r2, rA.Offset(-2).Resize(3))
      Next rA
      Intersect(r2, .EntireColumn).Select
    End If
  End With
End Sub

 

[jolivanes]

@ LazyBug
Re: "I didn't know that, thank you."
Make your own list(s) as needed for future uses. Saves on typing all these long arrays as well as other uses.