Merge cells from different rows depending on certain criteria

[gemf89]

Hello. I have been looking for an answer but obviously it is hard to find a case exactly like mine and I dont have the technical nous to change anything without screwing it up. If you can help I will be very grateful.

I get an auto-generated spreadsheet from a software. This is a sales software where I can find many orders with different products and there is row for every product even in the same order. I need to merge those rows into only one for every order.

Original spreadsheet

Client	Order No.	Product	Price
Robert	001	Apples	2
Robert	001	Oranges	1
Max	002	Apples	2
Max	002	Oranges	1
Max	003	Apples	2

<tbody>
</tbody>

What I need is to automatically detect every single order No. and merge those rows into one. Like these:

Client	Order No.	Product	Price
Robert	001	Apples-Oranges	2-1
Max	002	Apples-Oranges	2-1
Max	003	Apples	2

<tbody>
</tbody>

thank you!

 

[PCL]

See next code

Option Explicit


Sub MergeCells()
Const FR = 2
Dim DataDic   As Object
Set DataDic = CreateObject("Scripting.Dictionary")
Dim Rg As Range
Dim I  As Integer
Dim AAA, BBB
    Columns(4).Cells.NumberFormat = "@"
    For I = FR To Cells(Rows.Count, 1).End(3).Row
        With DataDic
            If (.exists(Cells(I, 1) & Cells(I, 2))) Then
                Cells(.Item(Cells(I, 1) & Cells(I, 2)), 3) = Cells(.Item(Cells(I, 1) & Cells(I, 2)), 3) & " - " & Cells(I, 3)
                Cells(.Item(Cells(I, 1) & Cells(I, 2)), 4) = Cells(.Item(Cells(I, 1) & Cells(I, 2)), 4) & " - " & Cells(I, 4)
                Cells(I, 1) = ""
            Else
                .Item(Cells(I, 1) & Cells(I, 2)) = I
            End If
            AAA = .keys: BBB = .items
        End With
    Next
    Columns(1).Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    MsgBox ("Job Done")
End Sub