Reduce duplicates to 1 with a count of how many before
Hi Howard,
Am Mon, 24 Feb 2014 22:21:57 -0800 (PST) schrieb L. Howard:
P-3122
F3UT2BA000457 <note serial number here
P-3122
F3UT3C5000495
P-3122
F3UT3C4000059
P-3123
QBDA1C7000402
you are in the wrong thread ;-)
Your data starts in A1. Option Base 1 is NOT needed for the following
macro:
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("A1:A" & LRow)
myCt = WorksheetFunction.CountIf(Range("A1:A" & LRow), "P" & "*")
For i = LBound(myArr) To UBound(myArr)
ReDim Preserve arrOut(myCt - 1, 1)
If Left(myArr(i, 1), 1) = "P" Then
arrOut(j, 0) = myArr(i, 1)
j = j + 1
Else
arrOut(j - 1, 1) = myArr(i, 1)
End If
Next
Range("A1:B" & LRow).ClearContents
Range("A1").Resize(UBound(arrOut) + 1, 2) = arrOut
End Sub
Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
|