• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

need vba code that can rearrange records having a repeated id#

hello again
i ask your intervention excel gurus
please review example attached
i need a vba that allows me save lots of time : have about 5000 records in a table like format; the records have the leftmost column filled ("clave" header) with a data that is repeated; vba should rearrange data in adjacent cells for a single "clave" (so as to list the record as a whole row of data pertaining to a unique "clave" identifier)
i hope you can assist me
i need to turn processed listing as part of closing business
much ppreciated once again
have a good weekend
looking forward to your reply before monday
take care ya'll
 

Attachments

  • example of vba needed_rearrangement.xlsm
    15 KB · Views: 4
1) You should respond to your previous thread before you start ask next question.
http://forum.chandoo.org/threads/co...le-cell-replicated-into-several-unique.33849/
2) Meaningless heading in "Raw data" sheet after col.H should be deleted.
Otherwise, it can not be flexible such like this.
Code:
Sub test()
    Dim a, i As Long, ii As Long, ub As Long, w
    a = [a5].CurrentRegion.Resize(, 8).Value
    ub = UBound(a, 2)
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                .Item(a(i, 1)) = Array(.Count + 1, ub)
                For ii = 1 To ub
                    a(.Item(a(i, 1))(0), ii) = a(i, ii)
                Next
            Else
                w = .Item(a(i, 1))
                If UBound(a, 2) < w(1) + ub - 1 Then ReDim Preserve a(1 To UBound(a, 1), 1 To w(1) + ub - 1)
                For ii = 2 To ub
                    a(w(0), w(1) + ii - 1) = a(i, ii)
                Next
                w(1) = w(1) + ub - 1: .Item(a(i, 1)) = w
            End If
        Next
        i = .Count
    End With
    With Sheets(3).Cells(1).Resize(, UBound(a, 2))
        .CurrentRegion.Offset(1).ClearContents
        .Rows(2).Resize(i).Value = a
        .Columns.AutoFit: .Parent.Select
    End With
End Sub
 
Back
Top