Ozan Ayten
Ozan Ayten

Reputation: 1473

Excel consolidate same values on column1 while keeping data

I have a excel table which looks like this one.

Picture1

As you can see, this products 2005 and 3004 are listed more than once because this same products have different price value based on sale scala. Like, if you buy 50 each of that item, the price gets lower.

What I want is -assuming there is a way to achieve- is this :

Picture2

ProductID Column is Unique and entrys with same product ID gathers on 1 row. With their Sale Scala and Price(Per) values added(if there is) within next columns. Is there a solution to alter the table like this with coding ? There is too much line to manually edit.

Please Suggest. Thanks.



Upvotes: 1

Views: 102

Answers (1)

Automate This
Automate This

Reputation: 31364

There are probably better ways to do this but I've created a simple loop that looks for duplicate values in column A then processes the data accordingly. I'm working bottom up for simplicity. Note: You'll have to manually create your headers when finished unless you want to add more logic.

EDIT Simpler code

Sub TransposeData()
    Dim WS As Worksheet
    Dim LastCell As Range
    Dim LastCellRowNumber As Long

    Set WS = Worksheets("Sheet1")
    With WS
        Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
        LastCellRowNumber = LastCell.Row
    End With

    'Loop through column A bottom up
    For i = LastCellRowNumber To 2 Step -1
        ' Check if value in current cell matches value in cell above it
        If (Range("A" & i).Value = Range("A" & i).Offset(-1, 0).Value) Then
            'Shift current values over
            Range("C" & i & ":D" & i).Insert Shift:=xlToRight

            'Copy new values down
            Range("C" & i).Value = Range("C" & i - 1).Value
            Range("D" & i).Value = Range("D" & i - 1).Value

            'Delete row
            Rows(i - 1).Delete Shift:=xlUp
        End If
    Next i
End Sub

Results:

enter image description here

Upvotes: 2

Related Questions