Auto ReArrange

[jyokom]

I recieve an automated report from a system that is not currently modifiable. I need to be able to rearrange the report by running a macro. The layout of the report is as follows:

name1 event1 accomplishdate1 expiredate1
name1 event2 accomplishdate2 expiredate2
name1 event3 accomplishdate3 expiredate3

name2 event1 accomplishdate1 expiredate1
name2 event2 accomplishdate2 expiredate2
name2 event3 accomplishdate3 expiredate3

and so on... (not always the same number of names, but the number of events are constant)

I need it to be the following:

NAME____EVENT1___EVENT2___EVENT3
______ acc | exp__acc | exp__acc | exp
name1
name2
name3

(ignore the underlines, they are just there for structure)
I hope this makes sense.

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim ShNew As Worksheet
    Dim First As Boolean
    Dim r As Long
    Dim c As Integer
    Dim Cell As Range
    Set Sh = Worksheets("Sheet1")
    Set Rng = Sh.Range("A1").CurrentRegion
    Set ShNew = Worksheets.Add
    ShNew.Cells(1, 1).Value = "Name"
    First = True
    r = 3
    c = 2
    For Each Cell In Rng.Columns(1).Cells
        If First = True Then
            First = False
        ElseIf Cell.Value <> Cell.Offset(-1).Value Then
            r = r + 1
            c = 2
        End If
        With ShNew
            .Cells(1, c).Value = Cell.Offset(0, 1).Value
            .Cells(2, c).Value = "acc"
            .Cells(2, c + 1).Value = "exp"
            .Cells(r, 1).Value = Cell.Value
            .Cells(r, c).Value = Cell.Offset(0, 2).Value
            .Cells(r, c + 1).Value = Cell.Offset(0, 3).Value
        End With
        c = c + 2
    Next Cell
    ShNew.Cells.EntireColumn.AutoFit
End Sub

 

[jyokom]

That works great! With a little tweaking, I should be able to cut way down on the current prep work.
Thank you

 

[jyokom]

I missed something in the original description. It should be:

name1 eventID1 eventDescription1 accomplishdate1 expiredate1
...

Convert to:
NAME____EVENTID1___EVENTDESCR1__EVENT2___EVENTDESCR2___EVENT3___EVENTDESCR3
______________acc | exp_______________acc | exp________________acc | exp
name1
name2
name3

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim ShNew As Worksheet
    Dim First As Boolean
    Dim r As Long
    Dim c As Integer
    Dim Cell As Range
    Set Sh = Worksheets("Sheet1")
    Set Rng = Sh.Range("A1").CurrentRegion
    Set ShNew = Worksheets.Add
    ShNew.Cells(1, 1).Value = "Name"
    First = True
    r = 3
    c = 2
    For Each Cell In Rng.Columns(1).Cells
        If First = True Then
            First = False
        ElseIf Cell.Value <> Cell.Offset(-1).Value Then
            r = r + 1
            c = 2
        End If
        With ShNew
            .Cells(1, c).Value = Cell.Offset(0, 1).Value
            .Cells(1, c + 1).Value = Cell.Offset(0, 2).Value
            .Cells(2, c).Value = "acc"
            .Cells(2, c + 1).Value = "exp"
            .Cells(r, 1).Value = Cell.Value
            .Cells(r, c).Value = Cell.Offset(0, 3).Value
            .Cells(r, c + 1).Value = Cell.Offset(0, 4).Value
        End With
        c = c + 2
    Next Cell
    ShNew.Cells.EntireColumn.AutoFit
End Sub