View Single Post
  #31   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default 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