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

Hi Howard,

Am Fri, 6 Feb 2015 03:05:39 -0800 (PST) schrieb L. Howard:

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)

try it with autofilter. This way is more reliable and faster:

Sub AP_by_State()
Dim LRow As Long

With Sheets("State AP")
LRow = .Cells(Rows.Count, "C").End(xlUp).Row
.Columns("C").AutoFilter Field:=1, _
Criteria1:="*, " & .Range("B1") & "*"
.Range("C2:C" & LRow).Copy .Range("F1")
.Range("C2:C" & LRow).SpecialCells(xlCellTypeVisible) _
.Interior.ColorIndex = 19
.AutoFilterMode = False
End With
End Sub

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

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

Call AP_by_State

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi again,

Am Fri, 6 Feb 2015 12:37:03 +0100 schrieb Claus Busch:

try it with autofilter. This way is more reliable and faster:

insert a header in column C


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Fri, 6 Feb 2015 03:05:39 -0800 (PST) schrieb L. Howard:

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.

if you want to do it with an array try this way. Stepping through an
array is faster than stepping through the cells:

Sub AP_by_State2()
Dim LRow As Long
Dim varIn As Variant, varOut() As Variant
Dim i As Long, n As Long
Dim sAP As String

With Sheets("State AP")
sAP = ", " & .Range("B1")
LRow = .Cells(Rows.Count, "C").End(xlUp).Row
varIn = .Range("C1:C" & LRow)
For i = LBound(varIn) To UBound(varIn)
ReDim Preserve varOut(n)
If InStr(varIn(i, 1), sAP) Then
varOut(n) = varIn(i, 1)
n = n + 1
End If
Next
.Range("F1").Resize(rowsize:=n) = _
Application.Transpose(varOut)
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Friday, February 6, 2015 at 3:52:58 AM UTC-8, Claus Busch wrote:
Hi Howard,

Am Fri, 6 Feb 2015 03:05:39 -0800 (PST) schrieb L. Howard:

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.

if you want to do it with an array try this way. Stepping through an
array is faster than stepping through the cells:

Sub AP_by_State2()
Dim LRow As Long
Dim varIn As Variant, varOut() As Variant
Dim i As Long, n As Long
Dim sAP As String

With Sheets("State AP")
sAP = ", " & .Range("B1")
LRow = .Cells(Rows.Count, "C").End(xlUp).Row
varIn = .Range("C1:C" & LRow)
For i = LBound(varIn) To UBound(varIn)
ReDim Preserve varOut(n)
If InStr(varIn(i, 1), sAP) Then
varOut(n) = varIn(i, 1)
n = n + 1
End If
Next
.Range("F1").Resize(rowsize:=n) = _
Application.Transpose(varOut)
End With
End Sub


Regards
Claus B.
--


I'll take these and give them a try and let you know how I made out.

Thanks.
Howard

I'll take these and give them a try and let you know how I made out.

Thanks.
Howard


Hi Claus,

Indeed they both work excellent, as you would already know.

I like the filter and considered trying it myself, but was stymied by how to filter in the code with a string from a cell on the sheet.

And both are very fast!

Thanks a lot.

Howard

Hi Howard,

Am Fri, 6 Feb 2015 05:03:44 -0800 (PST) schrieb L. Howard:

Indeed they both work excellent, as you would already know.

you are welcome. Always glad to help.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional