VBA code to Sum duplicate values then delete duplicate rows

W

whassan

New Member
Joined
Dec 10, 2015
Messages
25
Office Version
  1. 2010
Platform
  1. Windows
Hi All,

I have 4 columns in my spreadsheet. I am trying to find any duplicates that may exist in Col D, sum values in Col C and concatenate corresponding values in Col B , then delete the entire row.

I have found VBA code on MRExcel website but honestly don't know how to tweak this code as per my requirements.

Any help that you can provide would be most appreciative.

I have attached data sample illustrating before and after as picture.

Before:

Col A Col B Col C Col D
AccountingGroupMon 06-Dec-21
321_AFSPRODUCT 1
39,400.00​
XS2395583995
321_AFSPRODUCT 2
67,800.00​
XS2395583995
321_AFSPRODUCT 3
67,800.00​
XS2395583995
321_AFSPRODUCT 4
29,500.00​
XS2395584456
321_AFSPRODUCT 5
67,400.00​
XS2395584456
321_AFSPRODUCT 6
2,000.00​
XS2395584456
321_AFSPRODUCT 7
9,100.00​
XS2395584456


After:

Col A Col B Col C Col D
AccountingGroupMon 06-Dec-21
321_AFSPRODUCT 1, PRODUCT 2, PRODUCT 3
175,000.00​
XS2395583995
321_AFSPRODUCT 4, PRODUCT 5, PRODUCT 6, PRODUCT 7
108,000.00​
XS2395584456


Sub Test()
Dim Sh As Worksheet
Dim LastRow As Long
Dim Rng As Range
Set Sh = Worksheets(1)
Sh.Columns(5).Insert
LastRow = Sh.Range("A65536").End(xlUp).Row
With Sh.Range("A1:A" & LastRow).Offset(0, 4)
.FormulaR1C1 = "=IF(COUNTIF(R1C[-4]:RC[-4],RC[-4])>1,"""",SUMIF(R1C[-4]:R[" & LastRow & "]C[-4],RC[-4],R1C[-1]:R[" & LastRow & "]C[-1]))"
.Value = .Value
End With
Sh.Columns(4).Delete
Sh.Rows(1).Insert
Set Rng = Sh.Range("D1:D" & LastRow + 1)
With Rng
.AutoFilter Field:=1, Criteria1:="="
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub
 
Sort by date Sort by votes
Alex Blakenburg said:
I have seen a number of references to you having attached screenshots but I have not been able to see any sign of anything being attached.
Can you try just copying and pasting in the images ? Unless Jeff can see it I don't know how he will be able to help you without it.
Click to expand...
Cell Value: XS2393987404 PCode: XS2330059168
Cell Value: XS2393987586 PCode: XS2330059168
Cell Value: XS2393987743 PCode: XS2330059168
Cell Value: XS2405372900 PCode: XS2330059168
Cell Value: XS2405373031 PCode: XS2330059168
Cell Value: XS2405373114 PCode: XS2330059168
Cell Value: XS2405373205 PCode: XS2330059168
Cell Value: XS2405373387 PCode: XS2330059168
Cell Value: XS2405373460 PCode: XS2330059168
Cell Value: XS2418255076 PCode: XS2330059168
Cell Value: XS2418255316 PCode: XS2330059168
Cell Value: XS2418255589 PCode: XS2330059168
Cell Value: XS2418255662 PCode: XS2330059168
Cell Value: XS2418255829 PCode: XS2330059168
Cell Value: XS2418256397 PCode: XS2330059168
Cell Value: XS2418256637 PCode: XS2330059168
Cell Value: XS2418256801 PCode: XS2330059168
Cell Value: XS2418256983 PCode: XS2330059168
Cell Value: XS2418258500 PCode: XS2330059168
Cell Value: XS2418258500 PCode: XS2330059168
Cell Value: XS2418258849 PCode: XS2330059168
Cell Value: XS2418259144 PCode: XS2330059168
Cell Value: XS2340135305 PCode: XS2330059168
Cell Value: XS2340135560 PCode: XS2330059168
Cell Value: XS2340135644 PCode: XS2330059168
Cell Value: XS2361717957 PCode: XS2330059168
Cell Value: XS2361718096 PCode: XS2330059168
Cell Value: XS2373423560 PCode: XS2330059168
Cell Value: XS2373423644 PCode: XS2330059168
Cell Value: XS2373423727 PCode: XS2330059168
Cell Value: XS2373423990 PCode: XS2330059168
Cell Value: XS2373424022 PCode: XS2330059168
Cell Value: XS2373424295 PCode: XS2330059168
Cell Value: XS2394798396 PCode: XS2330059168
Cell Value: XS2394798479 PCode: XS2330059168
Cell Value: XS2394798552 PCode: XS2330059168
Cell Value: XS2394798552 PCode: XS2330059168
Cell Value: XS2394798636 PCode: XS2330059168
Cell Value: XS2394798719 PCode: XS2330059168
Cell Value: XS2394798800 PCode: XS2330059168
Cell Value: XS2418772302 PCode: XS2330059168
Cell Value: XS2418772484 PCode: XS2330059168
Cell Value: XS2418772567 PCode: XS2330059168
Cell Value: XS2418772724 PCode: XS2330059168
Cell Value: XS2418772641 PCode: XS2330059168
Cell Value: XS2418772641 PCode: XS2330059168
Cell Value: XS2418772997 PCode: XS2330059168
Cell Value: XS2418773029 PCode: XS2330059168
Cell Value: XS2418773292 PCode: XS2330059168
Cell Value: XS2329621358 PCode: XS2330059168
Cell Value: XS2384374745 PCode: XS2330059168
Cell Value: XS2384374828 PCode: XS2330059168
Cell Value: XS2384374828 PCode: XS2330059168
Cell Value: XS2384375551 PCode: XS2330059168
Cell Value: XS2384375551 PCode: XS2330059168
Cell Value: XS2384375635 PCode: XS2330059168
Cell Value: XS2384375718 PCode: XS2330059168
Cell Value: XS2384375809 PCode: XS2330059168
Cell Value: XS2384375981 PCode: XS2330059168
Cell Value: XS2384376013 PCode: XS2330059168
Cell Value: XS2384376104 PCode: XS2330059168
Cell Value: XS2384376286 PCode: XS2330059168
Cell Value: XS2384376286 PCode: XS2330059168
Cell Value: XS2384376369 PCode: XS2330059168
Cell Value: IE000D8F9DT5 PCode: XS2330059168

Cell Value: XS2403666816 PCode: XS2330059168
Cell Value: XS2403666907 PCode: XS2330059168
Cell Value: XS2403667038 PCode: XS2330059168
Cell Value: XS2417485617 PCode: XS2330059168
Cell Value: XS2417485708 PCode: XS2330059168
Cell Value: XS2417485880 PCode: XS2330059168
Cell Value: XS2417485963 PCode: XS2330059168
Cell Value: XS2417485963 PCode: XS2330059168
Cell Value: XS2417486003 PCode: XS2330059168
Cell Value: XS2417486185 PCode: XS2330059168
Cell Value: XS2417486268 PCode: XS2330059168
Cell Value: XS2417486268 PCode: XS2330059168
Cell Value: XS2417486342 PCode: XS2330059168
Cell Value: XS2417486425 PCode: XS2330059168
Cell Value: XS2417486425 PCode: XS2330059168
Cell Value: XS2417486854 PCode: XS2330059168
Cell Value: XS2417494874 PCode: XS2330059168
Cell Value: XS2417494957 PCode: XS2330059168
Cell Value: XS2327851106 PCode: XS2330059168
Cell Value: XS2327851288 PCode: XS2330059168
Cell Value: XS2338414639 PCode: XS2330059168
Cell Value: XS2348672887 PCode: XS2330059168
Cell Value: XS2348672960 PCode: XS2330059168
Cell Value: XS2348673182 PCode: XS2330059168
Cell Value: XS2348673265 PCode: XS2330059168
Cell Value: XS2370613221 PCode: XS2330059168
Cell Value: XS2370613494 PCode: XS2330059168
Cell Value: XS2370613577 PCode: XS2330059168
Cell Value: XS2370613650 PCode: XS2330059168
Cell Value: XS2370613734 PCode: XS2330059168
Cell Value: XS2382924921 PCode: XS2330059168
Cell Value: XS2382925068 PCode: XS2330059168
Cell Value: XS2382925142 PCode: XS2330059168
Cell Value: XS2382925225 PCode: XS2330059168
Cell Value: XS2382925498 PCode: XS2330059168
Cell Value: XS2382925571 PCode: XS2330059168
Cell Value: XS2382925654 PCode: XS2330059168
Cell Value: XS2404268117 PCode: XS2330059168
Cell Value: XS2404250339 PCode: XS2330059168
Cell Value: XS2404250412 PCode: XS2330059168
Cell Value: XS2404250503 PCode: XS2330059168
Cell Value: XS2404250685 PCode: XS2330059168
Cell Value: XS2404250685 PCode: XS2330059168
Cell Value: XS2404250768 PCode: XS2330059168
Cell Value: XS2404250842 PCode: XS2330059168
Cell Value: XS2417705758 PCode: XS2330059168
Cell Value: XS2417705832 PCode: XS2330059168
Cell Value: XS2417706053 PCode: XS2330059168
Cell Value: XS2417706301 PCode: XS2330059168
Cell Value: XS2417706566 PCode: XS2330059168
Cell Value: XS2417706640 PCode: XS2330059168
Cell Value: XS2417706723 PCode: XS2330059168
Cell Value: XS2417706996 PCode: XS2330059168
Cell Value: XS2417707291 PCode: XS2330059168
Cell Value: XS2349356407 PCode: XS2330059168
Cell Value: XS2349357470 PCode: XS2330059168
Cell Value: XS2349357553 PCode: XS2330059168
Cell Value: XS2349357637 PCode: XS2330059168
Cell Value: XS2371166401 PCode: XS2330059168
Cell Value: XS2371166583 PCode: XS2330059168
Cell Value: XS2371166823 PCode: XS2330059168
Cell Value: XS2371167045 PCode: XS2330059168
Cell Value: XS2371167128 PCode: XS2330059168
Cell Value: XS2383782492 PCode: XS2330059168
Cell Value: XS2383782575 PCode: XS2330059168
Cell Value: XS2383782658 PCode: XS2330059168
Cell Value: XS2383782732 PCode: XS2330059168
Cell Value: XS2383782732 PCode: XS2330059168
Cell Value: XS2383782815 PCode: XS2330059168
Cell Value: XS2383782906 PCode: XS2330059168
Cell Value: XS2383783037 PCode: XS2330059168
Cell Value: XS2383783110 PCode: XS2330059168
Cell Value: XS2383783201 PCode: XS2330059168
Cell Value: XS2393237073 PCode: XS2330059168
Cell Value: XS2393237230 PCode: XS2330059168
Cell Value: XS2393237404 PCode: XS2330059168
Cell Value: XS2393237586 PCode: XS2330059168
Cell Value: XS2393237743 PCode: XS2330059168
Cell Value: XS2393237743 PCode: XS2330059168
Cell Value: XS2393237826 PCode: XS2330059168
Cell Value: XS2393238121 PCode: XS2330059168
Cell Value: XS2393238394 PCode: XS2330059168
Cell Value: XS2393238477 PCode: XS2330059168
Cell Value: XS2404626306 PCode: XS2330059168
Cell Value: XS2404626488 PCode: XS2330059168
Cell Value: XS2404626561 PCode: XS2330059168
Cell Value: XS2404626645 PCode: XS2330059168
Cell Value: XS2404626728 PCode: XS2330059168
Cell Value: XS2404626991 PCode: XS2330059168
Cell Value: XS2404627023 PCode: XS2330059168
Cell Value: XS2404627296 PCode: XS2330059168
Cell Value: XS2349748827 PCode: XS2330059168
Cell Value: XS2349749049 PCode: XS2330059168
Cell Value: XS2360837996 PCode: XS2330059168
Cell Value: XS2360838028 PCode: XS2330059168
Cell Value: XS2360838291 PCode: XS2330059168
Cell Value: XS2360838374 PCode: XS2330059168
Cell Value: XS2360838457 PCode: XS2330059168
Cell Value: XS2372361498 PCode: XS2330059168
Cell Value: XS2372361571 PCode: XS2330059168
Cell Value: XS2372361654 PCode: XS2330059168
Cell Value: XS2372361654 PCode: XS2330059168
Cell Value: XS2372361738 PCode: XS2330059168
Cell Value: XS2372361811 PCode: XS2330059168
Cell Value: XS2372361902 PCode: XS2330059168
Cell Value: XS2393638817 PCode: XS2330059168
Cell Value: XS2393638908 PCode: XS2330059168
Cell Value: XS2393638908 PCode: XS2330059168
Cell Value: XS2393639039 PCode: XS2330059168
Cell Value: XS2393639039 PCode: XS2330059168
Cell Value: XS2393639112 PCode: XS2330059168
Cell Value: XS2393639203 PCode: XS2330059168
Cell Value: XS2393639385 PCode: XS2330059168
Cell Value: XS2393639468 PCode: XS2330059168
Cell Value: XS2393639542 PCode: XS2330059168
Cell Value: XS2404986932 PCode: XS2330059168
Cell Value: XS2404987070 PCode: XS2330059168
Cell Value: XS2404987070 PCode: XS2330059168
Cell Value: XS2404987153 PCode: XS2330059168
Cell Value: XS2404987153 PCode: XS2330059168
Cell Value: XS2404987237 PCode: XS2330059168
Cell Value: XS2404987237 PCode: XS2330059168
Cell Value: XS2404987310 PCode: XS2330059168
Cell Value: XS2404987401 PCode: XS2330059168
Cell Value: XS2405112744 PCode: XS2330059168
Cell Value: XS2328375865 PCode: XS2330059168
Cell Value: XS2339793411 PCode: XS2330059168
Cell Value: XS2361277531 PCode: XS2330059168
Cell Value: XS2361277614 PCode: XS2330059168
Cell Value: XS2361277887 PCode: XS2330059168
Cell Value: XS2361277887 PCode: XS2330059168
Cell Value: XS2373022578 PCode: XS2330059168
Cell Value: XS2393987313 PCode: XS2330059168
Cell Value: XS2393987404 PCode: XS2330059168
 
Upvote 0

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
whassan said:
Cell Value: XS2393987404 PCode: XS2330059168
Cell Value: XS2393987586 PCode: XS2330059168
Cell Value: XS2393987743 PCode: XS2330059168
Cell Value: XS2405372900 PCode: XS2330059168
Cell Value: XS2405373031 PCode: XS2330059168
Cell Value: XS2405373114 PCode: XS2330059168
Cell Value: XS2405373205 PCode: XS2330059168
Cell Value: XS2405373387 PCode: XS2330059168
Cell Value: XS2405373460 PCode: XS2330059168
Cell Value: XS2418255076 PCode: XS2330059168
Cell Value: XS2418255316 PCode: XS2330059168
Cell Value: XS2418255589 PCode: XS2330059168
Cell Value: XS2418255662 PCode: XS2330059168
Cell Value: XS2418255829 PCode: XS2330059168
Cell Value: XS2418256397 PCode: XS2330059168
Cell Value: XS2418256637 PCode: XS2330059168
Cell Value: XS2418256801 PCode: XS2330059168
Cell Value: XS2418256983 PCode: XS2330059168
Cell Value: XS2418258500 PCode: XS2330059168
Cell Value: XS2418258500 PCode: XS2330059168
Cell Value: XS2418258849 PCode: XS2330059168
Cell Value: XS2418259144 PCode: XS2330059168
Cell Value: XS2340135305 PCode: XS2330059168
Cell Value: XS2340135560 PCode: XS2330059168
Cell Value: XS2340135644 PCode: XS2330059168
Cell Value: XS2361717957 PCode: XS2330059168
Cell Value: XS2361718096 PCode: XS2330059168
Cell Value: XS2373423560 PCode: XS2330059168
Cell Value: XS2373423644 PCode: XS2330059168
Cell Value: XS2373423727 PCode: XS2330059168
Cell Value: XS2373423990 PCode: XS2330059168
Cell Value: XS2373424022 PCode: XS2330059168
Cell Value: XS2373424295 PCode: XS2330059168
Cell Value: XS2394798396 PCode: XS2330059168
Cell Value: XS2394798479 PCode: XS2330059168
Cell Value: XS2394798552 PCode: XS2330059168
Cell Value: XS2394798552 PCode: XS2330059168
Cell Value: XS2394798636 PCode: XS2330059168
Cell Value: XS2394798719 PCode: XS2330059168
Cell Value: XS2394798800 PCode: XS2330059168
Cell Value: XS2418772302 PCode: XS2330059168
Cell Value: XS2418772484 PCode: XS2330059168
Cell Value: XS2418772567 PCode: XS2330059168
Cell Value: XS2418772724 PCode: XS2330059168
Cell Value: XS2418772641 PCode: XS2330059168
Cell Value: XS2418772641 PCode: XS2330059168
Cell Value: XS2418772997 PCode: XS2330059168
Cell Value: XS2418773029 PCode: XS2330059168
Cell Value: XS2418773292 PCode: XS2330059168
Cell Value: XS2329621358 PCode: XS2330059168
Cell Value: XS2384374745 PCode: XS2330059168
Cell Value: XS2384374828 PCode: XS2330059168
Cell Value: XS2384374828 PCode: XS2330059168
Cell Value: XS2384375551 PCode: XS2330059168
Cell Value: XS2384375551 PCode: XS2330059168
Cell Value: XS2384375635 PCode: XS2330059168
Cell Value: XS2384375718 PCode: XS2330059168
Cell Value: XS2384375809 PCode: XS2330059168
Cell Value: XS2384375981 PCode: XS2330059168
Cell Value: XS2384376013 PCode: XS2330059168
Cell Value: XS2384376104 PCode: XS2330059168
Cell Value: XS2384376286 PCode: XS2330059168
Cell Value: XS2384376286 PCode: XS2330059168
Cell Value: XS2384376369 PCode: XS2330059168
Cell Value: IE000D8F9DT5 PCode: XS2330059168

Cell Value: XS2403666816 PCode: XS2330059168
Cell Value: XS2403666907 PCode: XS2330059168
Cell Value: XS2403667038 PCode: XS2330059168
Cell Value: XS2417485617 PCode: XS2330059168
Cell Value: XS2417485708 PCode: XS2330059168
Cell Value: XS2417485880 PCode: XS2330059168
Cell Value: XS2417485963 PCode: XS2330059168
Cell Value: XS2417485963 PCode: XS2330059168
Cell Value: XS2417486003 PCode: XS2330059168
Cell Value: XS2417486185 PCode: XS2330059168
Cell Value: XS2417486268 PCode: XS2330059168
Cell Value: XS2417486268 PCode: XS2330059168
Cell Value: XS2417486342 PCode: XS2330059168
Cell Value: XS2417486425 PCode: XS2330059168
Cell Value: XS2417486425 PCode: XS2330059168
Cell Value: XS2417486854 PCode: XS2330059168
Cell Value: XS2417494874 PCode: XS2330059168
Cell Value: XS2417494957 PCode: XS2330059168
Cell Value: XS2327851106 PCode: XS2330059168
Cell Value: XS2327851288 PCode: XS2330059168
Cell Value: XS2338414639 PCode: XS2330059168
Cell Value: XS2348672887 PCode: XS2330059168
Cell Value: XS2348672960 PCode: XS2330059168
Cell Value: XS2348673182 PCode: XS2330059168
Cell Value: XS2348673265 PCode: XS2330059168
Cell Value: XS2370613221 PCode: XS2330059168
Cell Value: XS2370613494 PCode: XS2330059168
Cell Value: XS2370613577 PCode: XS2330059168
Cell Value: XS2370613650 PCode: XS2330059168
Cell Value: XS2370613734 PCode: XS2330059168
Cell Value: XS2382924921 PCode: XS2330059168
Cell Value: XS2382925068 PCode: XS2330059168
Cell Value: XS2382925142 PCode: XS2330059168
Cell Value: XS2382925225 PCode: XS2330059168
Cell Value: XS2382925498 PCode: XS2330059168
Cell Value: XS2382925571 PCode: XS2330059168
Cell Value: XS2382925654 PCode: XS2330059168
Cell Value: XS2404268117 PCode: XS2330059168
Cell Value: XS2404250339 PCode: XS2330059168
Cell Value: XS2404250412 PCode: XS2330059168
Cell Value: XS2404250503 PCode: XS2330059168
Cell Value: XS2404250685 PCode: XS2330059168
Cell Value: XS2404250685 PCode: XS2330059168
Cell Value: XS2404250768 PCode: XS2330059168
Cell Value: XS2404250842 PCode: XS2330059168
Cell Value: XS2417705758 PCode: XS2330059168
Cell Value: XS2417705832 PCode: XS2330059168
Cell Value: XS2417706053 PCode: XS2330059168
Cell Value: XS2417706301 PCode: XS2330059168
Cell Value: XS2417706566 PCode: XS2330059168
Cell Value: XS2417706640 PCode: XS2330059168
Cell Value: XS2417706723 PCode: XS2330059168
Cell Value: XS2417706996 PCode: XS2330059168
Cell Value: XS2417707291 PCode: XS2330059168
Cell Value: XS2349356407 PCode: XS2330059168
Cell Value: XS2349357470 PCode: XS2330059168
Cell Value: XS2349357553 PCode: XS2330059168
Cell Value: XS2349357637 PCode: XS2330059168
Cell Value: XS2371166401 PCode: XS2330059168
Cell Value: XS2371166583 PCode: XS2330059168
Cell Value: XS2371166823 PCode: XS2330059168
Cell Value: XS2371167045 PCode: XS2330059168
Cell Value: XS2371167128 PCode: XS2330059168
Cell Value: XS2383782492 PCode: XS2330059168
Cell Value: XS2383782575 PCode: XS2330059168
Cell Value: XS2383782658 PCode: XS2330059168
Cell Value: XS2383782732 PCode: XS2330059168
Cell Value: XS2383782732 PCode: XS2330059168
Cell Value: XS2383782815 PCode: XS2330059168
Cell Value: XS2383782906 PCode: XS2330059168
Cell Value: XS2383783037 PCode: XS2330059168
Cell Value: XS2383783110 PCode: XS2330059168
Cell Value: XS2383783201 PCode: XS2330059168
Cell Value: XS2393237073 PCode: XS2330059168
Cell Value: XS2393237230 PCode: XS2330059168
Cell Value: XS2393237404 PCode: XS2330059168
Cell Value: XS2393237586 PCode: XS2330059168
Cell Value: XS2393237743 PCode: XS2330059168
Cell Value: XS2393237743 PCode: XS2330059168
Cell Value: XS2393237826 PCode: XS2330059168
Cell Value: XS2393238121 PCode: XS2330059168
Cell Value: XS2393238394 PCode: XS2330059168
Cell Value: XS2393238477 PCode: XS2330059168
Cell Value: XS2404626306 PCode: XS2330059168
Cell Value: XS2404626488 PCode: XS2330059168
Cell Value: XS2404626561 PCode: XS2330059168
Cell Value: XS2404626645 PCode: XS2330059168
Cell Value: XS2404626728 PCode: XS2330059168
Cell Value: XS2404626991 PCode: XS2330059168
Cell Value: XS2404627023 PCode: XS2330059168
Cell Value: XS2404627296 PCode: XS2330059168
Cell Value: XS2349748827 PCode: XS2330059168
Cell Value: XS2349749049 PCode: XS2330059168
Cell Value: XS2360837996 PCode: XS2330059168
Cell Value: XS2360838028 PCode: XS2330059168
Cell Value: XS2360838291 PCode: XS2330059168
Cell Value: XS2360838374 PCode: XS2330059168
Cell Value: XS2360838457 PCode: XS2330059168
Cell Value: XS2372361498 PCode: XS2330059168
Cell Value: XS2372361571 PCode: XS2330059168
Cell Value: XS2372361654 PCode: XS2330059168
Cell Value: XS2372361654 PCode: XS2330059168
Cell Value: XS2372361738 PCode: XS2330059168
Cell Value: XS2372361811 PCode: XS2330059168
Cell Value: XS2372361902 PCode: XS2330059168
Cell Value: XS2393638817 PCode: XS2330059168
Cell Value: XS2393638908 PCode: XS2330059168
Cell Value: XS2393638908 PCode: XS2330059168
Cell Value: XS2393639039 PCode: XS2330059168
Cell Value: XS2393639039 PCode: XS2330059168
Cell Value: XS2393639112 PCode: XS2330059168
Cell Value: XS2393639203 PCode: XS2330059168
Cell Value: XS2393639385 PCode: XS2330059168
Cell Value: XS2393639468 PCode: XS2330059168
Cell Value: XS2393639542 PCode: XS2330059168
Cell Value: XS2404986932 PCode: XS2330059168
Cell Value: XS2404987070 PCode: XS2330059168
Cell Value: XS2404987070 PCode: XS2330059168
Cell Value: XS2404987153 PCode: XS2330059168
Cell Value: XS2404987153 PCode: XS2330059168
Cell Value: XS2404987237 PCode: XS2330059168
Cell Value: XS2404987237 PCode: XS2330059168
Cell Value: XS2404987310 PCode: XS2330059168
Cell Value: XS2404987401 PCode: XS2330059168
Cell Value: XS2405112744 PCode: XS2330059168
Cell Value: XS2328375865 PCode: XS2330059168
Cell Value: XS2339793411 PCode: XS2330059168
Cell Value: XS2361277531 PCode: XS2330059168
Cell Value: XS2361277614 PCode: XS2330059168
Cell Value: XS2361277887 PCode: XS2330059168
Cell Value: XS2361277887 PCode: XS2330059168
Cell Value: XS2373022578 PCode: XS2330059168
Cell Value: XS2393987313 PCode: XS2330059168
Cell Value: XS2393987404 PCode: XS2330059168
Click to expand...
XS2330059168 is in D2 cell, A1 to D1 are header. I have attached a new screenshot.
 
Upvote 0
It's really hard to error test from this end without the exact same data set. The PCode variable is a STRING. Not understanding why it would fail. I changed one line of code to fix a potential problem. It checks to see how many duplicates there are, but the count includes the current pcode. I changed th red text so it would only run the summary if there was more than one.

VBA Code: 
Sub Summarize()
  Dim Cel As Range
  Dim R As Range
  Dim u As Range
  Dim CC As Range
  Dim RR As Range
  Dim Sht As Worksheet
  Dim PCode As String
  Dim PCodeRng As Range
  Dim BotRow As Range
  Dim TotalCost As Double
  Dim CostRng As Range
  Dim ProdStr As String
  Dim ProdRng As Range
  Dim AccGrp As String
  Dim Pu As Range
  Dim PCCnt As Long
  Dim X As Long
  
  Set Sht = Sheets("Sheet8")
  With Sht
    Set R = .Range(.Range("A2"), .Cells(.Cells.Rows.Count, 1).End(xlUp))    'Column A Data
    Set BotRow = .Range(.Cells(.Cells.Rows.Count, 1).End(xlUp), .Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(0, 3)) 'Bottom of data
  End With
  
  For Each Cel In R
    If Not u Is Nothing Then
      If Not Intersect(Cel, u) Is Nothing Then GoTo NextCell                'This row is already slated to be deleted
    End If
    PCode = Cel.Offset(0, 3).Value
    Set PCodeRng = Sht.Range(Cel.Offset(0, 3), Intersect(Cel.Offset(0, 3).EntireColumn, BotRow))
    PCCnt = Application.CountIf(PCodeRng, PCode)
   [COLOR=rgb(184, 49, 47)] If PCCnt > 1 Then[/COLOR]                                                       'More than one pcode
      Set CostRng = Sht.Range(Cel.Offset(0, 2), Intersect(Cel.Offset(0, 2).EntireColumn, BotRow)) 'Add this row also
      Set ProdRng = Sht.Range(Cel.Offset(1, 1), Intersect(Cel.Offset(0, 1).EntireColumn, BotRow)) 'Start with row below
      TotalCost = Application.SumIfs(CostRng, PCodeRng, PCode)
      AccGrp = Cel.Value
      If Not u Is Nothing Then                                              'Add This row to be deleted
        Set u = Union(u, Cel.EntireRow)
      Else
        Set u = Cel.EntireRow
      End If
      ProdStr = Cel.Offset(0, 1).Value                                                      'Add product code to string
      X = 1
      For Each CC In ProdRng
        Debug.Print "Cell Value: " & CC.Offset(0, 2).Value & "  PCode: " & PCode
        If CC.Offset(0, 2).Value = PCode Then
          ProdStr = ProdStr & ", " & CC.Value                               'Add next product code to string
          Set u = Union(u, CC.EntireRow)
          X = X + 1
          If X = PCCnt Then Exit For
        End If
      Next CC
      
      Set CC = Sht.Cells(Sht.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)    'Row Below all data
      CC.Value = AccGrp                                                     'Add new row with summarized data
      CC.Offset(0, 1).Value = ProdStr
      CC.Offset(0, 2).Value = TotalCost
      CC.Offset(0, 3).Value = PCode
    End If
NextCell:
  Next Cel
  If Not u Is Nothing Then
    u.EntireRow.Delete
  End If

  
End Sub
 
Upvote 0
Jeffrey Mahoney said:
It's really hard to error test from this end without the exact same data set. The PCode variable is a STRING. Not understanding why it would fail. I changed one line of code to fix a potential problem. It checks to see how many duplicates there are, but the count includes the current pcode. I changed th red text so it would only run the summary if there was more than one.

VBA Code: 
Sub Summarize()
  Dim Cel As Range
  Dim R As Range
  Dim u As Range
  Dim CC As Range
  Dim RR As Range
  Dim Sht As Worksheet
  Dim PCode As String
  Dim PCodeRng As Range
  Dim BotRow As Range
  Dim TotalCost As Double
  Dim CostRng As Range
  Dim ProdStr As String
  Dim ProdRng As Range
  Dim AccGrp As String
  Dim Pu As Range
  Dim PCCnt As Long
  Dim X As Long
 
  Set Sht = Sheets("Sheet8")
  With Sht
    Set R = .Range(.Range("A2"), .Cells(.Cells.Rows.Count, 1).End(xlUp))    'Column A Data
    Set BotRow = .Range(.Cells(.Cells.Rows.Count, 1).End(xlUp), .Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(0, 3)) 'Bottom of data
  End With
 
  For Each Cel In R
    If Not u Is Nothing Then
      If Not Intersect(Cel, u) Is Nothing Then GoTo NextCell                'This row is already slated to be deleted
    End If
    PCode = Cel.Offset(0, 3).Value
    Set PCodeRng = Sht.Range(Cel.Offset(0, 3), Intersect(Cel.Offset(0, 3).EntireColumn, BotRow))
    PCCnt = Application.CountIf(PCodeRng, PCode)
   [COLOR=rgb(184, 49, 47)] If PCCnt > 1 Then[/COLOR]                                                       'More than one pcode
      Set CostRng = Sht.Range(Cel.Offset(0, 2), Intersect(Cel.Offset(0, 2).EntireColumn, BotRow)) 'Add this row also
      Set ProdRng = Sht.Range(Cel.Offset(1, 1), Intersect(Cel.Offset(0, 1).EntireColumn, BotRow)) 'Start with row below
      TotalCost = Application.SumIfs(CostRng, PCodeRng, PCode)
      AccGrp = Cel.Value
      If Not u Is Nothing Then                                              'Add This row to be deleted
        Set u = Union(u, Cel.EntireRow)
      Else
        Set u = Cel.EntireRow
      End If
      ProdStr = Cel.Offset(0, 1).Value                                                      'Add product code to string
      X = 1
      For Each CC In ProdRng
        Debug.Print "Cell Value: " & CC.Offset(0, 2).Value & "  PCode: " & PCode
        If CC.Offset(0, 2).Value = PCode Then
          ProdStr = ProdStr & ", " & CC.Value                               'Add next product code to string
          Set u = Union(u, CC.EntireRow)
          X = X + 1
          If X = PCCnt Then Exit For
        End If
      Next CC
    
      Set CC = Sht.Cells(Sht.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)    'Row Below all data
      CC.Value = AccGrp                                                     'Add new row with summarized data
      CC.Offset(0, 1).Value = ProdStr
      CC.Offset(0, 2).Value = TotalCost
      CC.Offset(0, 3).Value = PCode
    End If
NextCell:
  Next Cel
  If Not u Is Nothing Then
    u.EntireRow.Delete
  End If

 
End Sub
Click to expand...

Jeffrey Mahoney said:
It's really hard to error test from this end without the exact same data set. The PCode variable is a STRING. Not understanding why it would fail. I changed one line of code to fix a potential problem. It checks to see how many duplicates there are, but the count includes the current pcode. I changed th red text so it would only run the summary if there was more than one.

VBA Code: 
Sub Summarize()
  Dim Cel As Range
  Dim R As Range
  Dim u As Range
  Dim CC As Range
  Dim RR As Range
  Dim Sht As Worksheet
  Dim PCode As String
  Dim PCodeRng As Range
  Dim BotRow As Range
  Dim TotalCost As Double
  Dim CostRng As Range
  Dim ProdStr As String
  Dim ProdRng As Range
  Dim AccGrp As String
  Dim Pu As Range
  Dim PCCnt As Long
  Dim X As Long
 
  Set Sht = Sheets("Sheet8")
  With Sht
    Set R = .Range(.Range("A2"), .Cells(.Cells.Rows.Count, 1).End(xlUp))    'Column A Data
    Set BotRow = .Range(.Cells(.Cells.Rows.Count, 1).End(xlUp), .Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(0, 3)) 'Bottom of data
  End With
 
  For Each Cel In R
    If Not u Is Nothing Then
      If Not Intersect(Cel, u) Is Nothing Then GoTo NextCell                'This row is already slated to be deleted
    End If
    PCode = Cel.Offset(0, 3).Value
    Set PCodeRng = Sht.Range(Cel.Offset(0, 3), Intersect(Cel.Offset(0, 3).EntireColumn, BotRow))
    PCCnt = Application.CountIf(PCodeRng, PCode)
   [COLOR=rgb(184, 49, 47)] If PCCnt > 1 Then[/COLOR]                                                       'More than one pcode
      Set CostRng = Sht.Range(Cel.Offset(0, 2), Intersect(Cel.Offset(0, 2).EntireColumn, BotRow)) 'Add this row also
      Set ProdRng = Sht.Range(Cel.Offset(1, 1), Intersect(Cel.Offset(0, 1).EntireColumn, BotRow)) 'Start with row below
      TotalCost = Application.SumIfs(CostRng, PCodeRng, PCode)
      AccGrp = Cel.Value
      If Not u Is Nothing Then                                              'Add This row to be deleted
        Set u = Union(u, Cel.EntireRow)
      Else
        Set u = Cel.EntireRow
      End If
      ProdStr = Cel.Offset(0, 1).Value                                                      'Add product code to string
      X = 1
      For Each CC In ProdRng
        Debug.Print "Cell Value: " & CC.Offset(0, 2).Value & "  PCode: " & PCode
        If CC.Offset(0, 2).Value = PCode Then
          ProdStr = ProdStr & ", " & CC.Value                               'Add next product code to string
          Set u = Union(u, CC.EntireRow)
          X = X + 1
          If X = PCCnt Then Exit For
        End If
      Next CC
     
      Set CC = Sht.Cells(Sht.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)    'Row Below all data
      CC.Value = AccGrp                                                     'Add new row with summarized data
      CC.Offset(0, 1).Value = ProdStr
      CC.Offset(0, 2).Value = TotalCost
      CC.Offset(0, 3).Value = PCode
    End If
NextCell:
  Next Cel
  If Not u Is Nothing Then
    u.EntireRow.Delete
  End If

 
End Sub
Click to expand...
@Jeffrey Mahoney - First of all, I must admit that it was mistake at my end that in column D there were some #N/A values hence your code was giving an Error.
Your code worked and did exactly what I wanted.
I would like to say my sincere thanks to you for all your efforts and time.

Wish you all the best!

Kind Regards,

​

 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Lowest value in range of cells excluding this row
2
Replies
10
Views
251
Peter_SSs
Peter_SSs
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
323
pure vito
P
H
  • Solved
Macro to display message end of Code where Col D contains blanks
Replies
7
Views
338
howard
H
Agnarr
  • Question
VBA code mix
Replies
1
Views
354
Joe4
Joe4
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
343
Agnarr
Agnarr

Forum statistics

Threads
1,214,833
Messages
6,121,861
Members
449,052
Latest member
Fuddy_Duddy

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top