CONSOLIDATING A LIST and adding values

[SQUIDD]

Morning

I have a list of names in column A lets say wood types
I have a lenght in column B
I have a quantity in column C

in column A a wood type could appear mulltiple instances. like below.

oak 2000 1
beech 2000 3
oak 1000 2
pine 3000 6
oak 50 2
oak 120 4
pine 100 7
beech 2500 5

i would like to consolidate this to be as below (by lenght x qty then adding all the same types together)

oak 4580
beech 18500
pine 18700

hoping infact i calculated my end correctly LOL

i have the tendancy to overcomplicate my code

thanks for looking, all help appriciated.

Dave

 

[Peter_SSs]

Is this what you mean?

Excel Workbook
	A	B	C	D	E	F
1
2	oak	2000	1		oak	4580
3	beech	2000	3		beech	18500
4	oak	1000	2		pine	18700
5	pine	3000	6
6	oak	50	2
7	oak	120	4
8	pine	100	7
9	beech	2500	5
Consolidate

 

[SQUIDD]

Hi Peter

Thats exactly the end result i wanted.
Its just the list we are consolidating is pasted into position with code.
So would like to do it with code if possible.
I suppose i could actually add at the bottom of the exising code, new code to write out the formula you have suggested.

is that a simple case of range("f2"),formula =

thanks for the help peter.

Dave

 

[SQUIDD]

Hi peter

I thinks its worth mentioning that the list of wood (not actually wood) is currently 200 item types and could grow daily.
So the lastrow of the formula would have to change accordingly and the formula copy down per item type.

thankyou

Dave

 

[SQUIDD]

Hi peter

Thanks for your help.
Its all done, i copied the list of names, run the remove duplicates code.

Columns("A:A").Copy
Columns("E:E").PasteSpecial
Columns("E").RemoveDuplicates Columns:=1, Header:=xlNo

Dave

 

[mohadin]

Sub test()
    Dim a As Variant, lr
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    a = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 3)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If Not .exists(a(i, 1)) Then
                .Add a(i, 1), a(i, 2) * a(i, 3)
            Else
                .Item(a(i, 1)) = .Item(a(i, 1)) + a(i, 2) * a(i, 3)
            End If
        Next
        k = .Count
        Range("d1:d" & .Count) = Application.Transpose(.keys)
        Range("e1:e" & .Count) = Application.Transpose(.items)
    End With
End Sub

 

[SQUIDD]

mohadin

great job, tidy, quick, i love it.

thanks so much

Dave

 

[mohadin]

So Happy you like it
thank you for feed back
Be happy

 

[Peter_SSs]

Its all done, i copied the list of names, run the remove duplicates code.

To be sure RemoveDuplicates works correctly, it is best to sort your data first. (Look at the example here to see what can happen if you don't sort first)

So, using your remove duplicates idea and my formula, it could be done without looping through all the rows like this.

Sub Consolidate_List()
  Application.ScreenUpdating = False
  With Range("E1:E" & Range("A" & Rows.Count).End(xlUp).Row)
    .Value = .Offset(, -4).Value
    .Sort Key1:=.Cells(1), Header:=xlNo
    .RemoveDuplicates Columns:=1, Header:=xlNo
    .Offset(, 1).Formula = Replace("=IF(E1="""","""",SUMPRODUCT(--(A$1:A$#=E1),B$1:B$#,C$1:C$#))", "#", .Rows.Count)
    .Value = .Value
  End With
  Application.ScreenUpdating = True
End Sub