Array coding type mismatch

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

L. Howard

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 nature:

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)
Click to expand...

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.
 
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:
Click to expand...

insert a header in column C


Regards
Claus B.
 
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.
Click to expand...

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.
 
Hi Howard,

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


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.
--
Click to expand...


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
Click to expand...


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.
Click to expand...

you are welcome. Always glad to help.


Regards
Claus B.
 
Back
Top