Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 14

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

  1. #1
    New Member
    Join Date
    Feb 2017
    Posts
    16
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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. #2
    Board Regular
    Join Date
    Jan 2009
    Location
    uk bexhill sussex
    Posts
    1,617
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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
    Some one always knows more than me,thats why I am here.

  3. #3
    New Member
    Join Date
    Feb 2017
    Posts
    16
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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. #4
    New Member
    Join Date
    Feb 2017
    Posts
    16
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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. #5
    Board Regular
    Join Date
    Jan 2009
    Location
    uk bexhill sussex
    Posts
    1,617
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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")
                .Range("A1:A" & lr2).RemoveDuplicates Columns:=1, Header:=xlNo
                .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
    Some one always knows more than me,thats why I am here.

  6. #6
    Board Regular
    Join Date
    Jan 2009
    Location
    uk bexhill sussex
    Posts
    1,617
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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")
                .Range("A1:A" & lr2).RemoveDuplicates Columns:=1, Header:=xlNo
                .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
    Some one always knows more than me,thats why I am here.

  7. #7
    New Member
    Join Date
    Feb 2017
    Posts
    16
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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. #8
    New Member
    Join Date
    Feb 2017
    Posts
    16
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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. #9
    Board Regular
    Join Date
    Jan 2009
    Location
    uk bexhill sussex
    Posts
    1,617
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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
    Some one always knows more than me,thats why I am here.

  10. #10
    Board Regular
    Join Date
    Jan 2009
    Location
    uk bexhill sussex
    Posts
    1,617
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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
    Last edited by SQUIDD; Apr 20th, 2017 at 06:02 PM.
    Some one always knows more than me,thats why I am here.

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
This website uses cookies
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.
     


DMCA.com