Tiding up duplicates in a list

[TrevorExcel]

I have a list of foods with the amounts of each food in the left column, the unit of measurement for these foods in the middle and the type of food in the right column. I have been trying to write a VBA code that will cycle through this list and 'tidy it up' for me if their are multiple entries of the same food. By 'tidy it up' I would like the duplicate foods in the list to be added up. Below is a before and after example.


Before:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]250[/TD]
[TD="align: center"]grams[/TD]
[TD="align: center"]carrot[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]tin[/TD]
[TD="align: center"]tomatoes[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"]grams[/TD]
[TD="align: center"]spinach[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]90[/TD]
[TD="align: center"]grams[/TD]
[TD="align: center"]carrot[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"]tin[/TD]
[TD="align: center"]tomatoes[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]0.5[/TD]
[TD="align: center"]bunch[/TD]
[TD="align: center"]basil[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"]400[/TD]
[TD="align: center"]grams[/TD]
[TD="align: center"]carrot[/TD]
[/TR]
</tbody>[/TABLE]

​

After:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]740[/TD]
[TD="align: center"]grams[/TD]
[TD="align: center"]carrrot[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]tin[/TD]
[TD="align: center"]tomatoes[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]50[/TD]
[TD="align: center"]grams[/TD]
[TD="align: center"]spinach[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]0.5[/TD]
[TD="align: center"]bunch[/TD]
[TD="align: center"]basil[/TD]
[/TR]
</tbody>[/TABLE]


I have been attempting to write a 'For loop' however I have not had much success.

Any help would be appreciated. Thanks in advance

 

[sandy666]

maybe try PowerQuery

[Table="width:, class:head"]
[tr=bgcolor:#FFFFFF][td=bgcolor:#5B9BD5]Column1[/td][td=bgcolor:#5B9BD5]Column2[/td][td=bgcolor:#5B9BD5]Column3[/td][td][/td][td=bgcolor:#70AD47]Sum[/td][td=bgcolor:#70AD47]Column2[/td][td=bgcolor:#70AD47]Column3[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#DDEBF7]

250​

[/td][td=bgcolor:#DDEBF7]grams[/td][td=bgcolor:#DDEBF7]carrot[/td][td][/td][td=bgcolor:#E2EFDA]

740​

[/td][td=bgcolor:#E2EFDA]grams[/td][td=bgcolor:#E2EFDA]carrot[/td][/tr]

[tr=bgcolor:#FFFFFF][td]

1​

[/td][td]tin[/td][td]tomatoes[/td][td][/td][td]

4​

[/td][td]tin[/td][td]tomatoes[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#DDEBF7]

50​

[/td][td=bgcolor:#DDEBF7]grams[/td][td=bgcolor:#DDEBF7]spinach[/td][td][/td][td=bgcolor:#E2EFDA]

50​

[/td][td=bgcolor:#E2EFDA]grams[/td][td=bgcolor:#E2EFDA]spinach[/td][/tr]

[tr=bgcolor:#FFFFFF][td]

90​

[/td][td]grams[/td][td]carrot[/td][td][/td][td]

0.5​

[/td][td]bunch[/td][td]basil[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#DDEBF7]

3​

[/td][td=bgcolor:#DDEBF7]tin[/td][td=bgcolor:#DDEBF7]tomatoes[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td]

0.5​

[/td][td]bunch[/td][td]basil[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#DDEBF7]

400​

[/td][td=bgcolor:#DDEBF7]grams[/td][td=bgcolor:#DDEBF7]carrot[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table]

[SIZE=1]let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Grouped Rows" = Table.Group(Source, {"Column2", "Column3"}, {{"Sum", each List.Sum([Column1]), type number}}),
    #"Reordered Columns" = Table.ReorderColumns(#"Grouped Rows",{"Sum", "Column2", "Column3"})
in
    #"Reordered Columns"[/SIZE]

 

[Yongle]

or with VBA
- assumes there is only ONE type of unit for each vegetable and that values begin in row 2
- amend sheetname
- new sheet containing summary added

Option Explicit
Sub Summarise()
    Dim ws1 As Worksheet, ws2 As Worksheet, rng As Range, cel As Range, r As Long
    Dim coll As New Collection, c As Variant
    Set ws1 = Sheets("[COLOR=#ff0000]SheetName[/COLOR]")

    Set rng = ws1.Range("[COLOR=#ff0000]C2[/COLOR]", ws1.Range("C" & Rows.Count).End(xlUp))
    '[COLOR=#0000cd][I]create unique values[/I][/COLOR]
    For Each cel In rng
        On Error Resume Next
        coll.Add CStr(cel), CStr(cel)
        On Error GoTo 0
    Next
    [I][COLOR=#0000cd]'create summary[/COLOR][/I]
    Set ws2 = Sheets.Add(after:=ws1)
    ws1.Range("A1:C1").Copy ws2.Range("A1")
    r = 1
    For Each c In coll
        r = r + 1
        ws2.Cells(r, 1) = WorksheetFunction.SumIf(rng, c, rng.Offset(, -2))
        ws2.Cells(r, 2) = rng.Find(c).Offset(, -1).Value
        ws2.Cells(r, 3) = c
    Next c
End Sub

 

[Yongle]

another VBA option
- entire table copied to a new sheet, values summed against each line and duplicatelines removed

Sub Summarise2()
    Dim ws1 As Worksheet, ws2 As Worksheet, rng1 As Range, rng2 As Range, cel As Range
    Set ws1 = Sheets("SheetName")
    Set rng1 = ws1.Range("C2", ws1.Range("C" & Rows.Count).End(xlUp))
    Set ws2 = Sheets.Add(after:=ws1)
    ws1.Range("A:C").Copy ws2.Range("A1")
    Set rng2 = ws2.Range("C2", ws2.Range("C" & Rows.Count).End(xlUp))
    For Each cel In rng2
        cel.Offset(, -2) = WorksheetFunction.SumIf(rng1, cel, rng1.Offset(, -2))
    Next cel
    ws2.Range("A:C").RemoveDuplicates Columns:=Array(1, 2, 3)
End Sub

Assumptions etc as in post#3