View Single Post
  #4   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 Sat, 22 Feb 2014 11:10:52 +0100 schrieb Claus Busch:

found an error. Try instead
Sub Test_CB2()


found an error. Try instead

Sub Test_CB2()
Dim LRow1 As Long, LRow2 As Long
Dim myArr As Variant
Dim rngC As Range

With Sheets("Sheet1")
LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
myArr = .Range("A1:B" & LRow1)
End With

With Sheets("Sheet2")
.Range("A1").Resize(LRow1, 2) = myArr
.Range("A1:B" & LRow1).RemoveDuplicates _
Columns:=Array(1, 2), Header:=xlNo
LRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each rngC In .Range("B1: B" & LRow2)
If Len(rngC) = 0 Then
rngC = WorksheetFunction.CountIf(Sheets("Sheet1") _
.Range("A1:A" & LRow1), rngC.Offset(, -1))
End If
Next
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2