Simple transpose help

[lwilt]

Hello,

I've tried tranposing this data a couple times and keep getting errors. Hoping a fresh pair or eyes will be able to do it for me. In the attachment there is a start and finish sheet so you can see how the data currently is and how I'd like it to look. Where every line that the order number is duplicated I want to move the Items(column C) into a single row so each order only shows once.

 

[lwilt]

I also posted this in two other locations:

http://www.excelforum.com/showthread.php?t=1143602&p=4411163#post4411163

http://www.mrexcel.com/forum/excel-questions/947257-simple-transpose-help.html#post4550651

 

[NARAYANK991]

Hi ,

There are better ways of doing this , but here is one way.

Narayan

 

[lwilt]

Appreciate the help but I have to have it where there are not blank cells before or in between the items. I have to take the items here and put them into a number workbook after this for something else and those blanks would cause problems in step 2.

 

[lwilt]

Solved.

 

[jindon]

This should do

Sub test()
    Dim a, i As Long, txt As String, w
    a = Sheets("start").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
            If Not .exists(txt) Then
                .Item(txt) = VBA.Array(.Count + 2, 2)
                a(.Count + 1, 1) = a(i, 1): a(.Count + 1, 2) = a(i, 2)
            End If
            w = .Item(txt): w(1) = w(1) + 1: .Item(txt) = w
            If UBound(a, 2) < w(1) Then ReDim Preserve a(1 To UBound(a, 1), 1 To w(1))
            a(w(0), w(1)) = a(i, 3)
        Next
        i = .Count + 1
    End With
    With Sheets("finish").Cells(1).Resize(i, UBound(a, 2))
        .CurrentRegion.ClearContents
        .Value = a: .Columns.AutoFit: .Parent.Select
    End With
End Sub