View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Soo Cheon Jheong[_2_] Soo Cheon Jheong[_2_] is offline
external usenet poster
 
Posts: 46
Default Adding Duplicates

(Updated)

Option Explicit
Sub TEST()

Dim S_1 As Worksheet
Dim S_2 As Worksheet
Dim R As Long
Dim str_F As String

Set S_1 = Worksheets("Data")
Set S_2 = Worksheets("Summary")

R = S_1.Cells(Rows.Count, 1).End(xlUp).Row
If R < 2 Then GoTo e:

S_2.Range("A:C").Clear
S_1.Range("A1:C" & R).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=S_2.Range("A1"), _
Unique:=True

str_F = "(__!$A$2:$A$~~&__!$B$2:$B$~~=A2&B2)*__!$C$2:$C$~~ )"
str_F = "=SUMPRODUCT(" & str_F
str_F = Application.Substitute(str_F, "__", S_1.Name)
str_F = Application.Substitute(str_F, "~~", R)

R = S_2.Cells(Rows.Count, 1).End(xlUp).Row
If R < 2 Then GoTo e:

With S_2.Range("C2:C" & R)
.Formula = str_F
.Value = .Value
End With

e:
Application.ScreenUpdating = True

End Sub


--
Regards,
Soo Cheon Jheong
Seoul, Korea
_ _
^вп^
--