Adding Duplicates

T

Tyler D.

I have data in 3 columns. I want to remove the duplicate line but add the
quantities. Any quick way?

I have something like this :

Client Item Qty
yyyy I256 10
xxxx I124 20
yyyy I256 10

I want :

Client Item Qty
yyyy I256 20
xxxx I124 20


Thanks

TD
 
S

Soo Cheon Jheong

Tyler,

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:

str_F = Application.Substitute(str_F, "~~", R)

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
_ _
^¢¯^
--
 
S

Soo Cheon Jheong

(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
_ _
^¢¯^
--
 
Top