A couple of ideas involving collections, marked A & B

Sub test()
Dim i As Long
Dim rng As Range
Dim ColRanges As Collection 'A
Dim colNames As Collection 'B
Dim arrStates()

arrStates = Array("Alaska", "Alabama", "Arizona")

ReDim ar(1 To UBound(arrStates) + 1) As Range

i = 0
Set ColRanges = New Collection ' A
Set colNames = New Collection ' B

For Each zone In arrStates
i = i + 1
ColRanges.Add Cells(i, 1), zone 'A

Set ar(i) = Cells(i, 2) 'B
colNames.Add i, zone 'B
Next

i = 0
For Each r In ColRanges 'A
i = i + 1
Debug.Print r.Address
Next

Debug.Print "Arizona", ColRanges("Arizona").Address 'A

Debug.Print ar(colNames("Arizona")).Address 'B

End Sub

For your Set to found cells (subject error handing)

method A
ColRanges.Add foundRange, "myState"

method B
first populate the colNames collection
Set ar(colNames("myState")) = foundRange

Regards,
Peter T

"Greg" wrote in message
...
Hi,

Is there a way to do the below implicitly in a loop or as array? Thank
you!


Dim States As Range
Dim Alaska As Range, Alabama As Range, Arizona As Range 'etc

Set States = Range("a2:a51")

With States
Set Alaska = .Cells.Find("Alaska", lookat:=xlWhole, MatchCase:=False)
Set Alabama = .Cells.Find("Alabama", lookat:=xlWhole,
MatchCase:=False)
'...
'..
'etc

End With

--
______
Regards,
Greg