Sum cells adjacent to duplicates and create only one row...

Francois Bekker

New Member
Joined
May 28, 2015
Messages
7
Please see a extract from my data set.

I would like to sum the cells adjacent to the left of the duplicates in the Service_Week Column. This means I would like to, in this example, sum (7+3) in Days_Active column and (0+0) in Wild_Moth_Count column and (9+3) in Sterile_Moth_count column. So my aim it to have one value for each Service_Week. In this case the service date and service day doesn't matter. I only need the to get the total amount of days active, Wild moth count and sterile moth count in each specific week.

Does anyone have a plan to sort out this problem please?

Kind regards


Trap_IDService_DateService_DayService_WeekDays_ActiveWild_Moth_CountSterile_Moth_Count
Ajlp 12010/01/20Wednesday3705
Ajlp 12010/02/01Monday512011
Ajlp 12010/02/08Monday6709
Ajlp 12010/02/11Thursday6303
Ajlp 12010/02/17Wednesday76047
Ajlp 12010/02/24Wednesday87012
Ajlp 12010/03/03Wednesday97085

<tbody>
</tbody>
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Try:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG28May49
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = Dn.Value & Dn.Offset(, 3).Value
    [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
        .Add Txt, Dn
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]For[/COLOR] n = 4 To 6
        .Item(Txt).Offset(, n).Value = _
        .Item(Txt).Offset(, n).Value + Dn.Offset(, n).Value
    [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

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