Bill of materials - consolidated sum

[sekar]

Hi.,

The below code is from one of the thread from the forum.

Sub MG03Nov36()
Dim Rng As Range, Dn As Range, n As Long, txt As String, Ac As Long
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 6)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    txt = Dn.Offset(, 2).Value & "," & Dn.Offset(, 3).Value & "," & _
        Dn.Offset(, 4).Value & Dn.Offset(, 5).Value
    If Not .Exists(txt) Then
        n = n + 1
        For Ac = 1 To 6
            ray(n, Ac) = Format(Dn.Offset(, Ac - 1), "@")
        Next Ac
        .Add txt, n
    Else
        ray(.Item(txt), 2) = ray(.Item(txt), 2) + Dn.Offset(, 1)
    End If
Next
End With
With Sheets("Sheet2").Range("A1").Resize(n, 6)
.Value = ray
 .Borders.Weight = 2
  .Columns.AutoFit
End With
End Sub

the output is as follows

Book1.xlsm
	A	B	C	D	E	F
1	ITEM	QTY	WIDTH	LENGTH	THICK	MATL
2	1	24	23	42	13/16	Solid Ash
3	2	2	26.375	32.875	04-03-22	Oak Ply
4	3	2	16.75	32.875	04-03-22	Oak Ply
5	4	2	3	32.375	04-03-22	Solid Ash
6	5	2	2.75	32.375	04-03-22	Solid Ash
7	6	2	1.5	32.375	04-03-22	Birch Ply
8	7	4	1.75	32.375	04-03-22	Birch Ply
9	8	24	2	9.5	1.25	Hardwood
10	9	24	1.5	19.5	04-03-22	Birch Ply
11	10	2	14.5	29.375	02-01-22	CDX Plywood
12	2	2	26.375	46.875	04-03-22	Oak Ply
13	3	2	16.75	46.875	04-03-22	Oak Ply
14	4	2	3	46.375	04-03-22	Solid Ash
15	5	2	2.75	46.375	04-03-22	Solid Ash
16	6	2	1.5	46.375	04-03-22	Birch Ply
17	7	4	1.75	46.375	04-03-22	Birch Ply
18	10	2	14.5	43.375	02-01-22	CDX Plywood
19	2	4	26.375	52.875	04-03-22	Oak Ply
20	3	4	16.75	52.875	04-03-22	Oak Ply
21	4	4	3	52.375	04-03-22	Solid Ash
22	5	4	2.75	52.375	04-03-22	Solid Ash
23	6	4	1.5	52.375	04-03-22	Birch Ply
24	7	8	1.75	52.375	04-03-22	Birch Ply
25	10	4	14.5	49.375	02-01-22	CDX Plywood
26	2	4	26.375	64.875	04-03-22	Oak Ply
27	3	4	16.75	64.875	04-03-22	Oak Ply
28	4	4	3	64.375	04-03-22	Solid Ash
29	5	4	2.75	64.375	04-03-22	Solid Ash
30	6	4	1.5	64.375	04-03-22	Birch Ply
31	7	8	1.75	64.375	04-03-22	Birch Ply
32	10	4	14.5	61.375	02-01-22	CDX Plywood
Sheet2

but i want consolidated sum of the materials ( 10 materials, no duplicates, with proper sum with respect to width, length and thick) with respect the quantities in the sheet 2. Presently the code is not giving desired output. It gives sum of qty correctly for the following higlighted cell.

Book1.xlsm
	A	B	C	D	E	F
1	ITEM	QTY	WIDTH	LENGTH	THICK	MATL
2	1	24	23	42	13/16	Solid Ash
3	2	2	26.375	32.875	04-03-22	Oak Ply
4	3	2	16.75	32.875	04-03-22	Oak Ply
5	4	2	3	32.375	04-03-22	Solid Ash
6	5	2	2.75	32.375	04-03-22	Solid Ash
7	6	2	1.5	32.375	04-03-22	Birch Ply
8	7	4	1.75	32.375	04-03-22	Birch Ply
9	8	24	2	9.5	1.25	Hardwood
10	9	24	1.5	19.5	04-03-22	Birch Ply
11	10	2	14.5	29.375	02-01-22	CDX Plywood
Sheet2

 

[bebo021999]

Is the sheet2 output? We need to see the raw data. Could you attach it?

 

[sekar]

Is the sheet2 output? We need to see the raw data. Could you attach it?

Hi bebo.,

I attached the raw data input sheet here. Missed to attached earlier. Sorry!.

Yes Sheet2 is the output Sheet, but the output was not correct, as there was additional data as like as input sheet, as well as the sum of qty was not outputted correctly, apart from few as mentioned earlier.

Book2
	A	B	C	D	E	F
1	ITEM	QTY	WIDTH	LENGTH	THICK	MATL
2	1	4	23	42	13/16	Solid Ash
3	2	2	26 3/8	32 7/8	3/4	Oak Ply
4	3	2	16 3/4	32 7/8	3/4	Oak Ply
5	4	2	3	32 3/8	3/4	Solid Ash
6	5	2	2 3/4	32 3/8	3/4	Solid Ash
7	6	2	1 1/2	32 3/8	3/4	Birch Ply
8	7	4	1 3/4	32 3/8	3/4	Birch Ply
9	8	4	2	9 1/2	1 1/4	Hardwood
10	9	4	1 1/2	19 1/2	3/4	Birch Ply
11	10	2	14 1/2	29 3/8	1/2	CDX Plywood
12	1	4	23	42	13/16	Solid Ash
13	2	2	26 3/8	46 7/8	3/4	Oak Ply
14	3	2	16 3/4	46 7/8	3/4	Oak Ply
15	4	2	3	46 3/8	3/4	Solid Ash
16	5	2	2 3/4	46 3/8	3/4	Solid Ash
17	6	2	1 1/2	46 3/8	3/4	Birch Ply
18	7	4	1 3/4	46 3/8	3/4	Birch Ply
19	8	4	2	9 1/2	1 1/4	Hardwood
20	9	4	1 1/2	19 1/2	3/4	Birch Ply
21	10	2	14 1/2	43 3/8	1/2	CDX Plywood
22	1	8	23	42	13/16	Solid Ash
23	2	4	26 3/8	52 7/8	3/4	Oak Ply
24	3	4	16 3/4	52 7/8	3/4	Oak Ply
25	4	4	3	52 3/8	3/4	Solid Ash
26	5	4	2 3/4	52 3/8	3/4	Solid Ash
27	6	4	1 1/2	52 3/8	3/4	Birch Ply
28	7	8	1 3/4	52 3/8	3/4	Birch Ply
29	8	8	2	9 1/2	1 1/4	Hardwood
30	9	8	1 1/2	19 1/2	3/4	Birch Ply
31	10	4	14 1/2	49 3/8	1/2	CDX Plywood
32	1	8	23	42	13/16	Solid Ash
33	2	4	26 3/8	64 7/8	3/4	Oak Ply
34	3	4	16 3/4	64 7/8	3/4	Oak Ply
35	4	4	3	64 3/8	3/4	Solid Ash
36	5	4	2 3/4	64 3/8	3/4	Solid Ash
37	6	4	1 1/2	64 3/8	3/4	Birch Ply
38	7	8	1 3/4	64 3/8	3/4	Birch Ply
39	8	8	2	9 1/2	1 1/4	Hardwood
40	9	8	1 1/2	19 1/2	3/4	Birch Ply
41	10	4	14 1/2	61 3/8	1/2	CDX Plywood
Sheet1

 

[bebo021999]

How about:

Sub Test()
Dim lr&, i&, k&, rng, arr(1 To 1000000, 1 To 6), id
Dim dic As Object, key
Set dic = CreateObject("scripting.dictionary")
Sheets("Sheet1").Activate
lr = Cells(Rows.Count, "F").End(xlUp).Row
rng = Evaluate("C2:C" & lr & "& ""|"" & D2:D" & lr & "& ""|"" & E2:E" & lr & " & ""|"" & F2:F" & lr & " & ""@"" & B2:B" & lr)
For i = 1 To UBound(rng)
    id = Split(rng(i, 1), "@")
    If Not dic.exists(id(0)) Then
        dic.Add id(0), id(1)
    Else
        dic(id(0)) = dic(id(0)) + CLng(id(1))
    End If
Next
For Each key In dic.keys
    k = k + 1
    arr(k, 1) = k: arr(k, 2) = dic(key)
    arr(k, 3) = Split(key, "|")(0): arr(k, 4) = Split(key, "|")(1)
    arr(k, 5) = Split(key, "|")(2): arr(k, 6) = Split(key, "|")(3)
Next
Range("T2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.keys)
Range("u2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.items)
Sheets("Sheet2").Activate
Range("A1:F1000000").Clear
Range("A1:F1").Value = Sheets("Sheet1").Range("A1:F1").Value
With Range("A2").Resize(k, 6)
    .Value = arr
    .Borders.Weight = 2
    .Columns.AutoFit
End With
End Sub

 

[sekar]

Hi beboo.,


1. The output doesn't summed for Qty of unique values (width, length, thickness and material).
2. The output was not generated in the sheet 2,it overwritten the existing values.
3. New Unwanted values generated in the sheet1,

 

[bebo021999]

Column T & U is for testing. I deleted it already.
With input data in Sheet1, Output in sheet2:

Sub Test()
Dim lr&, i&, k&, rng, arr(1 To 1000000, 1 To 6), id
Dim dic As Object, key
Set dic = CreateObject("scripting.dictionary")
Sheets("Sheet1").Activate
lr = Cells(Rows.Count, "F").End(xlUp).Row
rng = Evaluate("C2:C" & lr & "& ""|"" & D2:D" & lr & "& ""|"" & E2:E" & lr & " & ""|"" & F2:F" & lr & " & ""@"" & B2:B" & lr)
For i = 1 To UBound(rng)
    id = Split(rng(i, 1), "@")
    If Not dic.exists(id(0)) Then
        dic.Add id(0), id(1)
    Else
        dic(id(0)) = dic(id(0)) + CLng(id(1))
    End If
Next
For Each key In dic.keys
    k = k + 1
    arr(k, 1) = k: arr(k, 2) = dic(key)
    arr(k, 3) = Split(key, "|")(0): arr(k, 4) = Split(key, "|")(1)
    arr(k, 5) = Split(key, "|")(2): arr(k, 6) = Split(key, "|")(3)
Next
Sheets("Sheet2").Activate
Range("A1:F1000000").Clear
Range("A1:F1").Value = Sheets("Sheet1").Range("A1:F1").Value
With Range("A2").Resize(k, 6)
    .Value = arr
    .Borders.Weight = 2
    .Columns.AutoFit
End With
End Sub

Book1.xlsm

drive.google.com

 

[sekar]

Thanks bebo.,

You solved the problem, Thanks a lot.