I have 6 columns: The first four columns are repeated values and column E should be for the header row and column F should be the values
The headers are
Code: Select all
Suppose the rows for one item looks like that
---------------------------------------------------------
AA - 10/02/1998 - 10/03/1998 - 100 - S1 - Yes
AA - 10/02/1998 - 10/03/1998 - 100 - S2 - No
AA - 10/02/1998 - 10/03/1998 - 100 - S3 - Maybe
AA - 10/02/1998 - 10/03/1998 - 100 - S4 - NA
AA - 10/02/1998 - 10/03/1998 - 100 - S5- Real
The expected output
-------------------------
Code - Date1 - Date2 - Form Score - S1 - S2 - S3 - S4 - S5
AA - 10/02/1998 - 10/03/1998 - 100 - Yes - No - Maybe - NA- Real
I already have a code but couldn't modify it
[code]Sub Test()
Dim arr, v1, v2, coll As New Collection, s As String, max As Long, i As Long, j As Long
Application.ScreenUpdating = False
arr = Sheets(1).Range("A1").CurrentRegion.Value
For i = 1 To UBound(arr, 1)
s = CStr(arr(i, 1))
On Error Resume Next
coll.Add Key:=s, Item:=New Collection
On Error GoTo 0
If coll(s).Count = 0 Then coll(s).Add s
coll(s).Add CStr(arr(i, 6))
Next i
For Each v1 In coll
If v1.Count > max Then max = v1.Count
Next v1
ReDim arr(1 To coll.Count, 1 To max)
i = 0
For Each v1 In coll
i = i + 1
j = 0
For Each v2 In v1
j = j + 1
arr(i, j) = v2
Next v2
Next v1
For j = 2 To max
arr(1, j) = j - 1
Next j
With Sheets(3).Range("A1")
.CurrentRegion.Clear
.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
With .CurrentRegion
.EntireColumn.AutoFit
.Borders.Value = 1
End With
End With
Application.ScreenUpdating = True
End Sub