vba to condense similar cells into new cell, with total overall quantity.

[solidENM]

Hello,
I have a parts list that has many duplicate items, but different lengths for each piece to be cut at. when referring from this bill of materials to enter into the computer, i only need to enter one line with the total quantity. Each parts list is of varying lengths and random orders. I am hoping to find something that will scrape the list for similar parts and condense them.


Sample below. I would like line item# 1,2, and 3 to be condensed into one line, for total length of 12592mm (that multiplies qty in B2 by length in d2, and sums all similar woods from line c into one line). ideally, it would be great if this pops out the info on a new sheet, but i would be fine with it in column J-- or any column further to the right.

Item #	QTY	Description	Part Number	Length [mm]
1	4	mahogany	MHG887	1000
2	4	mahogany	MHG887	1299
3	6	mahogany	MHG887	566
4	12	white oak	WO992	1312

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

desired end result
J column K column (or on new sheet)
Mahogany 12592mm
White Oak 15744mm

 

[solidENM]

hi Squidd, I dont mind if sheet 3 is visible. Our system generates excel files, which we format and turn into price lists, cut sheets, etc. By default, they only have sheet 1. If possible, id like the macro to create a sheet 3 so we dont have to manually add it each time. This would be numerous times per day.

 

[solidENM]

Alrighty, I got it working. I ended up taking our price list template, and adding sheet 3 to that. this way when the macros we use create the price list, it creates this cut sheet you've been helping with onto the pricelist excel. I used the updated code you sent last night, thanks for all the help Dave.

 

[SQUIDD]

Ok, good stuff.

you are welcome.

im sure we could create what you desire without to much problem, but if youre happy with how its working then we can leave it.

let me know if you want the code changed.

one last thing, the only thing that MAY cause you a problem. The whole code is based around case sensitivity. so check that you will not have a problem, for instance, oak and OAK or Oak are all different.

you may have to test it to see how it reacts. only thought of it last night.

cheers

Dave

 

[solidENM]

Hey Squidd,
Your code has been working great. I need some help getting to the next version of this. Here's the summary since its been a while. The macro scrapes the main sheet, and copies all rows with info on col. E. This is then pasted onto sheet "profiles," and all duplicates are deleted. I have also added 5% to account for lumber cutoffs.

Would it be possible to have this all happen on the main page? We have been turning to sheet "profiles" for the sum, but are now wanting it to all be on the same page. We do not need all the untallied lumbers on the main page, just the total length for each type of lumber. I played around with the code but since there are other parts on sheet 1, I have been having trouble. Since the macro is working great, i tried to find an addon so i could delete all items on sheet1 that are represented on sheet 2 (profiles). Then, the items on sheet 2 would need to be pasted back onto sheet 1 as a single line item for each lumber type. I have not been successful in that.


this is what info each column has
A: line item# (not needed for this macro)
B: Qty each (ideally the macro will make this qty 1, with total length in col e for all similar lumber profiles)
c: description (macro case sensitivity doesn't matter since the computer spits them out in same format every time)
D: sku#
e: length

below is the code i am currently working with-- slight modifications from your helpful code.

' create profile sheet to paste total qty per type of profile
Sheets.Add.Name = "Profiles"
Sheets("Quote Sheet").Activate


' copy lumber profiles to profilesheet.


Sheets("Profiles").Columns("A:D").ClearContents
Range("C1:E" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Range("'Profiles'!A1").PasteSpecial
With Sheets("Profiles").Columns("A:D")
.Range("A1:C" & Range("'Profiles'!A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
' duplicate col c to col d
Sheets("Profiles").Range("C2:c30").Copy
Sheets("Profiles").Range("d2:d30").Paste
For a = 2 To Range("'Profiles'!A" & Rows.Count).End(xlUp).Row
total1 = 0
word1 = Range("'Profiles'!A" & a)
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Range("C" & i) = word1 Then total1 = total1 + Range("B" & i) * Range("E" & i) * 1.05
If Range("d" & i) = word1 Then total1 = total1 + Range("B" & i) * Range("E" & i)
Next
Range("'Profiles'!C" & a) = total1
Range("'Profiles'!d" & a) = total1 / 1.05


Next
Sheets("Profiles").Activate
For B = Range("'Profiles'!A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("'Profiles'!C" & B).Value = 0 Then Rows(B).EntireRow.Delete
Next B
' copy profile col C, to make duplicate in col H to rename to system values
Sheets("Profiles").Range("b:b").Copy Destination:=Sheets("Profiles").Range("f:f")