On Friday, February 21, 2014 6:48:36 AM UTC-8, Claus Busch wrote:
Hi Howard,



Am Fri, 21 Feb 2014 14:38:10 +0100 schrieb Claus Busch:



still a little bit faster. Write the array without the empty elements

into another array and dump it back into the sheet:



and once again a bit faster:



Option Explicit

Option Base 1



Sub MyScan5()

Dim LRow As Long

Dim myArr As Variant

Dim arrOut() As Variant

Dim i As Long, j As Long

Dim myCt As Long



LRow = Cells(Rows.Count, 1).End(xlUp).Row



myArr = Range("A2:A" & LRow)

myCt = WorksheetFunction.CountIf(Range("A2:A" & LRow), "P" & "*")

j = 1

For i = LBound(myArr) To UBound(myArr)

ReDim Preserve arrOut(myCt, 2)

If Left(myArr(i, 1), 1) = "P" Then

arrOut(j, 1) = myArr(i, 1)

j = j + 1

Else

arrOut(j - 1, 2) = myArr(i, 1)

End If

Next



Range("A2:B" & LRow).ClearContents

Range("A2").Resize(UBound(arrOut), 2) = arrOut



End Sub





Regards

Claus B.

--

Just got back to my computer.

Thanks for all the schooling, appreciate it.

I'll give the faster fastest code a try.

Thanks.

Howard