The Change Event code below works fine, except it is very slow as you would expect for a list in Column C of around 2000+ entries.

Trying to convert the Sub AP_by_State() to do the same as the event code.
It errors with a type mismatch as I have it now.

Entries are of this natu

Abilene, TX (ABI)
Abilene, TX (ABI)
Adak Island, AK (ADK)
Akiachak, AK (KKI)
Akiak, AK (AKI)
Akron/Canton, OH (CAK)
Akuton, AK (KQA)
Alakanuk, AK (AUK)
Alamogordo, NM (ALM)X
Alamosa, CO (ALS)

The state abbreviation is entered in cell B1 (TX for Texas, say) and all entries in column C with TX in them are highlighted.

AND

A list is compiled in column F of all those entries.

Using InStr() has risks of returning "Alamogordo, NM (ALM)" if OR for Oregon is the search string, but seem to be okay as long as the state abbreviation is uppercase and the user is aware of it.

Thanks.
Howard


Sub AP_by_State()
Dim varData() As Variant
Dim rngC As Range
Dim i As Long
Dim sAP As String

sAP = Range("B1")

With Sheets("State AP")
ReDim Preserve varData(sAP)
For Each rngC In .Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
If InStr(rngC, sAP) 0 Then
varData(i) = rngC
i = i + 1
End If
Next

.Range("F1").Resize(UBound(varData) + 1, 1) = _
Application.Transpose(varData)
End With
End Sub


Sub Worksheet_Change(ByVal Target As Range)
If Target.Count 1 Then Exit Sub
If Target < Range("B1") Then Exit Sub

Range("C:C").Interior.ColorIndex = xlNone
Range("F:F").ClearContents

Dim St As String
Dim c As Range

St = Range("B1")

For Each c In Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)

If InStr(c, St) 0 Then

c.Copy Range("F" & Rows.Count).End(xlUp)(2)
c.Interior.ColorIndex = 19 '15
End If

Next
End Sub