transposing large amounts of data

**Trailrunner47** · 11-12-2011, 09:37 AM

I have data organized in 3 columns as follows: ID, Date, Value with variable numbers of dates and corresponding Values for each ID. I have attached an excerpt in the worksheet.
I need it to look like this:
ID1, Date1, Date 2, Date 3, Value 1, Value 2, Value 3
ID2, Date 1, Date 2, Value 1, Value 2
ID3, Date1, Date 2, Date 3, Date 4, Date 5, Value 1, Value 2, Value 3, Value 4, Value 5
and so forth. All Date 1s should start in the same column, same with Value 1.

While I could do this manually with transpose function there are over 4000 rows. Any help would be appreciated. Thanks!

**JBeaucaire** · 11-12-2011, 12:44 PM

First let me iterate that your current layout is superior to the goal.

This will put all the dates together and the values together.

Option Explicit

Sub Reformat()
Dim delRNG As Range, LR As Long, Rw As Long, LastCOL As Long, c As Long, i As Long

LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

Set delRNG = Range("A" & LR + 1)        'seed the delrng for use

For Rw = LR To 3 Step -1
    If Range("A" & Rw) = Range("A" & Rw - 1) Then
        Range(Range("B" & Rw), Range("B" & Rw).End(xlToRight)).Copy Range("D" & Rw - 1)
        Set delRNG = Union(delRNG, Range("A" & Rw))
    End If
Next Rw

delRNG.EntireRow.Delete xlShiftUp
    
    LastCOL = Cells.Find("*", Cells(Rows.Count, Columns.Count), _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    i = 3       'where to insert cut columns
    For c = 4 To LastCOL Step 2
        Columns(c).Cut
        Columns(i).Insert
        i = i + 1
    Next c

Columns.AutoFit
Application.ScreenUpdating = True
End Sub