Thanks:  0
Likes:  0

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

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

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

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

2. ## Re: vba to condense similar cells into new cell, with total overall quantity.

Hi There

assuming you list of wood is in column J and this cantains all unique timbers from your list.

this should do what you require

Code:
```Sub total()
lr = Range("A" & Rows.Count).End(xlUp).Row
lr1 = Range("J" & Rows.Count).End(xlUp).Row
For a = 1 To lr1
total = 0
word1 = Range("j" & a)
For i = 2 To lr
If Range("C" & i) = word1 Then total = total + Range("B" & i) * Range("E" & i)
Next
Range("k" & a) = total
Next
End Sub```
if you want it output into a different sheet, let me know what the sheet name is.

Only thing i was not sure about was if you required the code to pull out all of your unique timbers from the list??

Dave

3. ## Re: vba to condense similar cells into new cell, with total overall quantity.

Hi Squidd, thanks for the quick reply. Yes, I would need the unique timbers pulled out too. I have all the various types of wood on Sheet2. With all the various end finishes, it comes out to 1137 total, so I would like to keep that on its own hidden sheet. Right now, it is used to pull up pricing onto the first page, but we never look at it.

as for the code, it is working great so far. I figure it would be fine if the code spits out doubles, since I could just expand the macro to delete duplicates in columns J and K.

4. ## Re: vba to condense similar cells into new cell, with total overall quantity.

Also, it would be great is 0 qty items would be removed. I have fasteners and other hardware on the lines below, they have no value for the Length in column E. They only have qty in B and description and part number in c & d.

you have already gotten me further than i could figure out by myself, thank you very much. I found it hard to describe what I was looking for, and the search on the website wasn't working too great as a result.

5. ## Re: vba to condense similar cells into new cell, with total overall quantity.

Hi Again

Try this code, i need to tidy it a bit if it works.

create yourself a sheet called "sheet3" for test purposes.

then run this code from your main sheet

Code:
```Sub total()

LR = Range("A" & Rows.Count).End(xlUp).Row
Range("C2:C" & LR).Copy
Range("'SHEET3'!A1").PasteSpecial

lr2 = Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row
With Sheets("sheet3").Columns("A:A")
.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With

lr1 = Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row
For a = 1 To lr1
total1 = 0
word1 = Range("'SHEET3'!A" & a)
For i = 2 To LR
If Range("C" & i) = word1 Then total1 = total1 + Range("B" & i) * Range("E" & i)
Next
Range("'SHEET3'!B" & a) = total1
Next
End Sub```
should pull out all the unique timbers from your list and put into sheet 3 column A then put the total into column B.

we can ann into the code also that if the total = 0 then Dont put into the list, but try this 1st, then i will add it and tidy things up.

Also if it works, let me know what sheet you want the output put into.

cheers

dave

6. ## Re: vba to condense similar cells into new cell, with total overall quantity.

Hi

I got to sign off now.(couple of hours)

But like i said before, create sheet3 and run this code from your main sheet, should now work and then delete all timbers that total 0.
Code:
```Sub total()

LASTROW = Range("A" & Rows.Count).End(xlUp).Row
Range("C2:C" & LASTROW).Copy
Range("'SHEET3'!A1").PasteSpecial

lr2 = Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row
With Sheets("sheet3").Columns("A:A")
.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With

lr1 = Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row
For a = 1 To lr1
total1 = 0
word1 = Range("'SHEET3'!A" & a)
For i = 2 To LASTROW
If Range("C" & i) = word1 Then total1 = total1 + Range("B" & i) * Range("E" & i)
Next
Range("'SHEET3'!B" & a) = total1
Next
Sheets("SHEET3").Activate
For B = Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row To 1 Step -1
If Range("'SHEET3'!B" & B).Value = 0 Then Rows(B).EntireRow.Delete
Next B
End Sub```
still got to tidy iot up, sorry, was in a bit of a rush.

Dave

7. ## Re: vba to condense similar cells into new cell, with total overall quantity.

I keep getting an error towards the end. If Range("C" & i) = word1 Then total1 = total1 + Range("B" & i) * Range("E" & i)

the blue part keeps coming back highlighted, with error "type mismatch"

it is pasting the info onto sheet3 after I created that sheet. This code alone isnt updating anything on the main sheet though.

8. ## Re: vba to condense similar cells into new cell, with total overall quantity.

found out what the error was with the above post. I had a formula in cell d1 (for page number). after deleting that cell it worked great.

Thanks for all the help SQUIDD.

would it be difficult to also have column D paste over onto the next page? Also, would it be possible to have the new sheet auto generate? Right now its only working if i make a Sheet3 first.

9. ## Re: vba to condense similar cells into new cell, with total overall quantity.

I can do column D no problem, can also apply your headers easily too.

Not sure what you mean by having sheet 3 auto generate, i mean, i know what you want, you want the code to generate sheet3.

BUT

Why can you not simply have sheet3 always in your workbook??

If it is because you dont want users to see it, probably best if you simply have the code to display the sheet(unhide) and then as soon as the user clicks a different sheet we could make the sheet hide again automatically.

Let me know.

Will add the other functions required and post back the code.

Dave

10. ## Re: vba to condense similar cells into new cell, with total overall quantity.

Hi

Ok

this should do the trick for you. This makes sheet 3 visible at the end of the code. then the code posted under , put that into sheet3 module, when you click a different sheet it will re-hide sheet 3.

let me know if you need any help OR this option will not work for you.

Code:
```Sub total()
Sheets("sheet3").Columns("A:C").ClearContents
Range("C1:E" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Range("'SHEET3'!A1").PasteSpecial
With Sheets("sheet3").Columns("A:C")
.Range("A1:C" & Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
For a = 2 To Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row
total1 = 0
word1 = Range("'SHEET3'!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)
Next
Range("'SHEET3'!C" & a) = total1
Next
Sheets("SHEET3").Activate
For B = Range("'SHEET3'!A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("'SHEET3'!C" & B).Value = 0 Then Rows(B).EntireRow.Delete
Next B
Sheets("Sheet3").Visible = True
End Sub```

create sheet3, right click on the tab and click view code, paste this into there.

Code:
```Private Sub Worksheet_Deactivate()
Sheets("Sheet3").Visible = False
End Sub```
Dave

## User Tag List

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•
We use cookies to store session information to facilitate remembering your login information, to allow you to save website preferences, to personalise content and ads, to provide social media features and to analyse our traffic. We also share information about your use of our site with our social media, advertising and analytics partners.