Merge/Combine Data, not sure of syntax

DANDERSON · Aug 3rd 2004

I am not sure exactly of the syntax I should be looking for in these forums. I am new to VB, so flame on, I dont mean to be lame.

I want to take the data, as seen below, and combine all the like Bar MArk's, into one line, and add up the QTY, FT & IN columns. The Bar Size column will not be added up. I would also like to get rid of the zeros. I will be doing this hundreds of times a month, so any help is GREATLY appreciated.

I have the following table:

QTY BAR SIZE FT IN BAR MARK
4 -- 3 10 RCBC1
4 -- 3 10 RCBC1
4 -- 3 10 RCBC1
2 6 7 3 MK646
2 6 7 3 MK646
2 6 7 3 MK646
3 6 4 5 MK642
3 6 4 5 MK642
3 6 4 5 MK642
1 6 4 6 MK641
1 6 4 6 MK641
1 6 4 6 MK641
8 6 2 1 MK631
8 6 2 1 MK631
8 6 2 1 MK631
25 4 6 9 MK405
25 4 6 9 MK405
25 4 6 9 MK405
46 4 2 6 MK404
46 4 2 6 MK404
46 4 2 6 MK404
46 4 7 9 MK402
46 4 7 9 MK402
46 4 7 9 MK402
4 11 49 2 114902
4 11 49 2 114902
4 11 49 2 114902
2 8 14 3 81403
2 8 14 3 81403
2 8 14 3 81403
6 8 5 2 80502
6 8 5 2 80502
6 8 5 2 80502
16 4 2 9 40209
16 4 2 9 40209
16 4 2 9 40209
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0

Here is an example of the outcome I would like:

4 -- 3 10 RCBC1
4 -- 3 10 RCBC1
4 -- 3 10 RCBC1

would turn into this:

12 0 9 30 RCBC1

And so on...and deleteing the ZEROS at the bottom..

Is this possible?

jindon · Aug 4th 2004

Hi,

in cell F2
=IF(COUNTIF(E$2:E2,E2)=1,ROW(),"") and drag down to the last row of the data in Col.A

in cell G2
=IF($F2<>"",SUMIF($E:$E,$E2,A:A),"") and drag to the right up to cell J2

in cell K2
=IF($F2<>"",E2,"")

then, select cells from G2 to K2 and drag down as long as you need.
select entire columns from F to K --> copy --> pastescpecial/values
sort by col.F in ascending order

if you don't need origial data, just delete columns from A to F

jindon

Anonymous · Aug 4th 2004

EDIT: I just saw that I misread your post. You were grouping based only on column E, I grouped based on the contents of the entire row matching. I need to fix my solution and post back.

I see jindon has already posted a formula solution while I was composing, but for whatit is worth, here is a VBA solution. It sorts the data first to make sure that all identical rows are grouped together, so it changes the order of yoru sample data (which was, I think, already grouped). If your data is always grouped appropriately, you can remove the sorting code.

Code

Sub AddSort()
Dim Lastrow As Long, QTY As Integer, BAR As Variant
Dim FT As Integer, INCH As Integer, MARK As Variant
Dim r As Long, CONCAT as String


' Turn off screen updating to avoid flicker
Application.ScreenUpdating = False


' Determine the last used row
Lastrow = Range("A65536").End(xlUp).Row


' Fill column F with CONCATENTATE formulas and sort rows to put like entries
' in consequtive rows
Range("F2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-5],RC[-4],RC[-3],RC[-2],RC[-1])"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F" & Lastrow)
Range("F2:F45").Select
Cells.Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(Lastrow, 1).Select


' March through the rows from the bottom up, adding like entries if numbers
' and deleting rows after processing them
For r = Lastrow To 2 Step -1
    If Cells(r, 6).Value = "00000" Then
        Rows(r).EntireRow.Delete
        ' Skip the variable updating if the row was deleted
        GoTo SkipTo
    End If
    
' Update variables if the next row is the same
    If CONCAT = Cells(r, 6).Value Then
            QTY = Cells(r, 1).Value + QTY
            If IsNumeric(Cells(r, 2)) Then
                BAR = Cells(r, 2).Value + BAR
                Else: BAR = 0
            End If
            FT = Cells(r, 3).Value + FT
            INCH = Cells(r, 4).Value + INCH
            Rows(r).EntireRow.Delete
            
' Otherwise print the result of the previous row grouping and start over
        Else
            If Not r = Lastrow Then
                Cells(r + 1, 1).Value = QTY
                Cells(r + 1, 2).Value = BAR
                Cells(r + 1, 3).Value = FT
                Cells(r + 1, 4).Value = INCH
                Cells(r + 1, 5).Value = MARK
            End If
            CONCAT = Cells(r, 6)
            QTY = Cells(r, 1).Value
            BAR = Cells(r, 2).Value
            FT = Cells(r, 3).Value
            INCH = Cells(r, 4).Value
            MARK = Cells(r, 5).Value
    End If
SkipTo:
Next r


' Delete the column of CONCATENATE formulas created for the processing
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft


Range("A1").Select
Application.ScreenUpdating = True
End Sub

Display More

The file with your sample data and the above macro is attached.

Anonymous · Aug 4th 2004

Updated (Fixed) Code

Ok, here is some updated code that matches the problem you posted and and updated attachment.

Code

Sub AddSort()
    Dim Lastrow As Long, QTY As Integer, BAR As Variant
    Dim FT As Integer, INCH As Integer, MARK As Variant
    Dim r As Long
     
     ' Turn off screen updating to avoid flicker
    Application.ScreenUpdating = False
     
     ' Determine the last used row
    Lastrow = Range("A65536").End(xlUp).Row
     
     ' Fill column F with CONCATENTATE formulas and sort rows to put like entries
     ' in consequtive rows
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-5],RC[-4],RC[-3],RC[-2],RC[-1])"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F" & Lastrow)
    
    Cells.Select
    Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=Yes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
     
     ' March through the rows from the bottom up, adding like entries if numbers
     ' and deleting rows after processing them
    For r = Lastrow To 2 Step -1
        If Cells(r, 6).Value = "00000" Then
            Rows(r).EntireRow.Delete
             ' Skip the variable updating if the row was deleted
            GoTo SkipTo
        End If


    
' Update variables if the next row is the same
    If MARK = Cells(r, 5).Value Then
            QTY = Cells(r, 1).Value + QTY
            If IsNumeric(Cells(r, 2)) Then
                BAR = Cells(r, 2).Value + BAR
                Else: BAR = 0
            End If
            FT = Cells(r, 3).Value + FT
            INCH = Cells(r, 4).Value + INCH
            Rows(r).EntireRow.Delete
            
' Otherwise print the result of the previous row grouping and start over
        Else
            If Not r = Lastrow Then
                Cells(r + 1, 1).Value = QTY
                Cells(r + 1, 2).Value = BAR
                Cells(r + 1, 3).Value = FT
                Cells(r + 1, 4).Value = INCH
                Cells(r + 1, 5).Value = MARK
            End If
            QTY = Cells(r, 1).Value
            BAR = Cells(r, 2).Value
            FT = Cells(r, 3).Value
            INCH = Cells(r, 4).Value
            MARK = Cells(r, 5).Value
    End If
SkipTo:
Next r


' Delete the column of CONCATENATE formulas created for the processing
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft


Range("A1").Select
Application.ScreenUpdating = True
End Sub

Display More

DANDERSON · Aug 4th 2004

Outstanding!!! Thank you all. I have made a mistake in my interpretation of what needed to be done. The BAR FT IN MARK need to be left alone, just combined, and the QTY is the only column that needs to be added up....I did not think I would have had so much to work with. I will try to look at the code and work with it to modify it. Thanks again. I REALLY appreciate it. If you have a simple modification fix, please dont hesitate. I am really new to this wonderful world of VB, and now can appreciate the fun that can be placed back into Excel.

:thanx:

Anonymous · Aug 4th 2004

I have not had a chance to test this, but I think all you need to do is change the following portion of the code:

Code

' Update variables if the next row is the same
        If MARK = Cells(r, 5).Value Then 
            QTY = Cells(r, 1).Value + QTY 
            If IsNumeric(Cells(r, 2)) Then 
                BAR = Cells(r, 2).Value + BAR 
            Else: BAR = 0 
            End If 
            FT = Cells(r, 3).Value + FT 
            INCH = Cells(r, 4).Value + INCH 
            Rows(r).EntireRow.Delete

to

Code

' Update variables if the next row is the same
        If MARK = Cells(r, 5).Value Then 
            QTY = Cells(r, 1).Value + QTY 
            Rows(r).EntireRow.Delete

This should increment QTY only.

DANDERSON · Aug 4th 2004

Thats IT!!!

Wow, that was a simple modification!!! That is exactly the outcome I needed! Thanks again. I am just so happy. I have been writing this code for 3 days now, and that was the last part I need to figure out. Now I can finish it up, and move on to learn more. I have been learning to write AutoCAD to Excel. This is great!

:thanx:

DANDERSON · Aug 6th 2004

1st Item's QTY will not add up? Puzzled, can't determine why.

I am done coding my entire app and checking values, and notice that the first line of the data does not add up the QTY, it combines it ok. I cant seem to figure it out.

Just look at the file attached in the previous post for code and data: Group & Add v2.xls

If you look at the original data:
16 4 2 9 40209
16 4 2 9 40209
16 4 2 9 40209

3 rows should add up to QTY=48, but sorted data reads 16 on DATA tab.

I ran a few tests and it seems that the 1st sorted item is the only one not adding up. Any help is appreciated. Thanks! I'll keep workin gon it.

DANDERSON · Aug 6th 2004

Work Around

I found a work around by creating a bogus data line that would always be sorted first, that wat the QTY would count up right, then I just delete the bogus data at the end, but since I am learning, I was hoping somebody could explain why?

Thanks everyone.

Anonymous · Aug 7th 2004

Oops

Good catch. My code never got around to printing out the last set of accumulations. This also left the top row of the last data grouping untouched (never overwritten) and in place. -- A nice story line but a very weak ending!

Here is code that should work (file attached). It assumes there is a header row and the data start in row 2.

Code

Sub AddSort()
    Dim Lastrow As Long, QTY As Integer, BAR As Variant
    Dim FT As Integer, INCH As Integer, MARK As Variant
    Dim r As Long
     
     ' Turn off screen updating to avoid flicker
    Application.ScreenUpdating = False
     
     ' Determine the last used row
    Lastrow = Range("A65536").End(xlUp).Row
     
     ' Fill column F with CONCATENTATE formulas and sort rows to put like entries
     ' in consequtive rows
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-5],RC[-4],RC[-3],RC[-2],RC[-1])"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F" & Lastrow)
    
    Cells.Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
     
     ' March through the rows from the bottom up, adding like entries if numbers
     ' and deleting rows after processing them
    For r = Lastrow To 2 Step -1
        If Cells(r, 6).Value = "00000" Then
            Rows(r).EntireRow.Delete
        ' Skip the variable updating if the row was deleted
            GoTo SkipTo
        End If


    
' Update variables if the next row is the same
    If MARK = Cells(r, 5).Value Then
            QTY = Cells(r, 1).Value + QTY
            If IsNumeric(Cells(r, 2)) Then
                BAR = Cells(r, 2).Value + BAR
                Else: BAR = 0
            End If
            FT = Cells(r, 3).Value + FT
            INCH = Cells(r, 4).Value + INCH
            Rows(r).EntireRow.Delete
            
' Otherwise print the result of the previous row grouping and start over
        Else
            If Not r = Lastrow Then
                Cells(r + 1, 1).Value = QTY
                Cells(r + 1, 2).Value = BAR
                Cells(r + 1, 3).Value = FT
                Cells(r + 1, 4).Value = INCH
                Cells(r + 1, 5).Value = MARK
            End If
            QTY = Cells(r, 1).Value
            BAR = Cells(r, 2).Value
            FT = Cells(r, 3).Value
            INCH = Cells(r, 4).Value
            MARK = Cells(r, 5).Value
    End If
SkipTo:
Next r


' Print the current accumulated totals to row 2 before exiting.
    Cells(2, 1).Value = QTY
    Cells(2, 2).Value = BAR
    Cells(2, 3).Value = FT
    Cells(2, 4).Value = INCH
    Cells(2, 5).Value = MARK




' Delete the column of CONCATENATE formulas created for the processing
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft


Range("A1").Select
Application.ScreenUpdating = True
End Sub

Display More

DANDERSON · Aug 9th 2004

Sweet! I can follow that now.

Thanks! So much to learn!

I really appreciate it, and hope I can help others as well one day.

Merge/Combine Data, not sure of syntax

Participate now!

Share