Combine Duplicate Data Into One Row and Add Column Data

A

AcornNut

Board Regular
Joined
Aug 19, 2014
Messages
51
Hello. I know this topic has been discussed in other posts, but every time I try to modify the codes I cannot get it to work.

I have a supply order form where column D has the name of each item and columns H (used), I (expired), J (damaged), and L (new) have the numbers that need to be ordered for that item.
My inventory sheet is laid out by location where each item is kept, but a single item type might be kept in multiple locations. I have a code that looks through the locations and when it finds something needs to be ordered, it populates my order form with the correct number in the correct column.

For example... I have item "x" is kept in 2 different locations.
Location #1 has 5 of this item, and 1 is used, leaving only 4. The code reads 1 missing, adds "Item X" in column D of the order form and a "1" in column H (used).
Location #2 also has 5 of this item, but 1 is used and 2 are expiring. The code will add this to a different row on the order form, again adding "Item X" in column D of the order form and a "1" in column H (used), and a "2" in column I (expired).

I need the code to consolidate the duplicate items in column D, and add the totals for each column (one row for item X with a "2" in column H (used) and a "2" in column I (expired).

Ideally, this would be checked each time the code goes to add an item to the order form, that way duplicate rows won't have to be deleted.
As a curve ball, the length of the order form may change. Currently, the row range is 24 to 53 by default. But if more rows are needed, then the code automatically adds the rows and inserts the data. See below for my "Fill Order" code (maybe it'll help you understand what it's doing)...

If this "duplication check" has to be completed once the below code has run, then fine, but that seems like it would be long and drawn out. Ideally, the search and sums would happen while the code below is running, but it's not a "make-or-break" thing for me.

Any help is GREATLY appreciated!
And thanks in advance!
Using Excel 2016

Code: 
Sub fillorder1()   Dim finalrow As Long
   Dim i As Integer
   Dim ExpDate As Date
   Dim lastRow As Long, NextRow As Long
   Dim Flg As Boolean
   
   Application.ScreenUpdating = False
   
    Number_1 = 1
    Number_2 = Cells(6, 4)
    
    NextRow = 54
    lastRow = Sheets("Supply Usage Form").Range("B22").End(xlDown).Row + 1
    finalrow = Sheets("Location").Range("B9").End(xlDown).Row
    ExpDate = Date + 30
        
    Flg = True
    For i = 9 To finalrow
        If Flg And lastRow > 53 Then
            Rows(NextRow).Insert
            Rows(53).Copy
            Rows(NextRow).PasteSpecial xlFormats
            lastRow = NextRow
            NextRow = NextRow + 1
        End If
        Flg = False
        If (Sheets("Location").Cells(i, 12) <> "") And (Sheets("Location").Cells(i, 13) = "") Then
            Sheets("Location").Cells(i, 1).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(, 0).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 2).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(0, 2).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 12).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(0, 5).PasteSpecial xlPasteValuesAndNumberFormats
            lastRow = lastRow + 1
            Flg = True
        ElseIf (Sheets("Location").Cells(i, 12) = "") And (Sheets("Location").Cells(i, 13) <> "") Then
            Sheets("Location").Cells(i, 1).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(, 0).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 2).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(0, 1).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 13).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(0, 6).PasteSpecial xlPasteValuesAndNumberFormats
            lastRow = lastRow + 1
            Flg = True
        ElseIf (Sheets("Location").Cells(i, 12) <> "") And (Sheets("Location").Cells(i, 13) <> "") Then
            Sheets("Location").Cells(i, 1).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(, 0).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 2).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(0, 2).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 12).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(0, 5).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 13).Copy
                Sheets("Supply Usage Form").Range("B" & lastRow).Offset(0, 6).PasteSpecial xlPasteValuesAndNumberFormats
            lastRow = lastRow + 1
            Flg = True
        End If
    
    Next i
    
    lastRow = Sheets("Supply Usage Form").Range("B24").End(xlDown).Row + 1
        If Sheets("Supply Usage Form").Range("B" & lastRow).Row > 53 Then
            Rows(lastRow).Delete
        End If
   Application.ScreenUpdating = True
End Sub
 
Last edited:

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
I've got something that I think is on the right track, but I cannot get it to work. If I start with a blank supply order form, then the code just "spins its wheels" and does nothing. If there's data already there with duplicates, then does what I need it to, but doesn't delete every row (it leaves one set of rows moved more to the bottom of the table. Very strange. Any thoughts on how to clean this up?

Code: 
Sub fillorder1()
   Dim finalrow As Long
   Dim i As Integer
   Dim ExpDate As Date
   Dim lastrow As Long, NextRow As Long
   Dim Flg As Boolean
   Dim LR As Long
   Application.ScreenUpdating = False
   
    Number_1 = 1
    Number_2 = Cells(6, 4)
    LR = Sheets("Supply Usage Form").Range("B24").End(xlDown).Row
    NextRow = 54
    lastrow = Sheets("Supply Usage Form").Range("B22").End(xlDown).Row + 1
    finalrow = Sheets("Location").Range("B9").End(xlDown).Row
    ExpDate = Date + 30
        
    Flg = True
    For i = 9 To finalrow
        If Flg And lastrow > 53 Then
            Rows(NextRow).Insert
            Rows(53).Copy
            Rows(NextRow).PasteSpecial xlFormats
            lastrow = NextRow
            NextRow = NextRow + 1
        End If
        Flg = False
        If (Sheets("Location").Cells(i, 12) <> "") And (Sheets("Location").Cells(i, 13) = "") Then
            Sheets("Location").Cells(i, 1).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(, 0).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 2).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(0, 2).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 12).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(0, 5).PasteSpecial xlPasteValuesAndNumberFormats
            lastrow = lastrow + 1
            Flg = True
        ElseIf (Sheets("Location").Cells(i, 12) = "") And (Sheets("Location").Cells(i, 13) <> "") Then
            Sheets("Location").Cells(i, 1).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(, 0).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 2).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(0, 1).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 13).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(0, 6).PasteSpecial xlPasteValuesAndNumberFormats
            lastrow = lastrow + 1
            Flg = True
        ElseIf (Sheets("Location").Cells(i, 12) <> "") And (Sheets("Location").Cells(i, 13) <> "") Then
            Sheets("Location").Cells(i, 1).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(, 0).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 2).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(0, 2).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 12).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(0, 5).PasteSpecial xlPasteValuesAndNumberFormats
            Sheets("Location").Cells(i, 13).Copy
                Sheets("Supply Usage Form").Range("B" & lastrow).Offset(0, 6).PasteSpecial xlPasteValuesAndNumberFormats
            lastrow = lastrow + 1
            Flg = True
        End If
    Next i
        
Flg = True
For x = LR To 24 Step -1
    For y = 24 To LR
        If Sheets("Supply Usage Form").Cells(x, 2).Value = Sheets("Supply Usage Form").Cells(y, 2).Value And x > y Then
           Sheets("Supply Usage Form").Cells(y, 8).Value = Sheets("Supply Usage Form").Cells(x, 8).Value + Cells(y, 8).Value
           Sheets("Supply Usage Form").Cells(y, 9).Value = Sheets("Supply Usage Form").Cells(x, 9).Value + Cells(y, 9).Value
           Sheets("Supply Usage Form").Cells(y, 10).Value = Sheets("Supply Usage Form").Cells(x, 10).Value + Cells(y, 10).Value
           Sheets("Supply Usage Form").Cells(y, 12).Value = Sheets("Supply Usage Form").Cells(x, 12).Value + Cells(y, 12).Value
        Rows(x).EntireRow.ClearContents
        Exit For
        End If
    Next y
Next x
Flg = True






lastrow = Sheets("Supply Usage Form").Range("B24").End(xlDown).Row + 1
        If Sheets("Supply Usage Form").Range("B" & lastrow).Row > 53 Then
            Rows(lastrow).Delete
        End If
        
    If Range("C9") = "" Then
    UserForm3.Show
    End If
    
    If Range("F9") = "" Then
    UserForm4.Show
    End If
   Sheets("Supply Usage Form").Cells(6, 4).Value = Number_2 + Number_1
   
   Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Change macro range from column A to B
2
Replies
10
Views
146
sachin483
S
G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
389
Peter_SSs
Peter_SSs
O
  • Solved
VBA - floating photo
Replies
3
Views
525
RoryA
RoryA
A
  • Solved
setting a range from Active cell to last cell when Active cell change columns
2
Replies
12
Views
608
jolivanes
jolivanes
A
  • Question Question
VBA Copy/Paste New Data Only
Replies
0
Views
446
ah2024_2024
A

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top