Hi Joe,

This macro seems to work...

Public Sub Joe()
Application.ScreenUpdating = False
Dim lngLastRow As Long
Dim lngLastColumnSource As Long
Dim lnglastColumnDestination As Long
Dim I As Long
lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For I = lngLastRow To 2 Step -1
If Cells(I, 1).Value = _
Cells(I, 1).Offset(-1, 0).Value Then
lngLastColumnSource = _
Cells(I, Columns.Count).End(xlToLeft).Column
lnglastColumnDestination = _
Cells(I - 1, Columns.Count).End(xlToLeft).Column
Range(Cells(I, 2), Cells(I, lngLastColumnSource)).Copy _
Cells(I - 1, lnglastColumnDestination + 1)
Rows(I).Delete shift:=xlUp
End If
Next I
End Sub

Try it out on a copy of your data first. It is very easy to wreck data
with a macro if you're not careful. What macros do can't be undone. The
safest way is to save before running the macro, then if the macro does
not do what you were wanting, you close the file without saving, then
reopen it.

To get the macro code in place...

1. copy it.

2 Go to Excel and get into the Visual Basic Editor by either pressing
Alt + F11 or going Tool|Macro|Visual Basic Editor.

3. In the Visual BAsic Editor go Inset|Module then paste the code into
that new Module.

4. Go back to Normal Excel by either pressing Alt + F11 or going
File|Close and Return to Microsoft Excel

5.To run the code go Tools|Macro|Macros...look for the macro name (Joe)
in the List of Macro names, select it then click the Run button. If you
can't see the macro name then select "This Workbook" from the "Macros
in:" drop down menu at the bottom of the "Macro" dialog.

Ken Johnson

Check whether this will work or not on your case.
On your workbook your data is in,  open the Visual Basic Editor (Tools >
Macro > Visual Basic Editor or ALT+F11), then choose Insert > Module and you
will have a standard code module named like Module1. copy the code below to
this Module1. return to the worksheet the data is in and choose tool > macro
and run the macro named mytest0.  i assume ID# is in A1.

Sub mytest0()
Dim acwk As Worksheet, dstwk As Worksheet
Dim rng As Range, rng1 As Range, dstrng As Range
Dim id As Range
Dim i As Long, cl As Long
Dim ar
Const Extract = "Extract Data" 'Sheet's name of Extracted date

Set id = Range("a1") 'Change to your ID# range

Set acwk = ActiveSheet
Set rng1 = Range(id, id.End(xlDown))
rng1.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
cl = id.CurrentRegion.Columns.count
Set rng = rng1.SpecialCells(xlCellTypeVisible)
ReDim ar(rng.count - 1)
For Each r In rng
   ar(i) = r.Value
   i = i + 1
Next
On Error Resume Next
Set dstwk = Worksheets(Extract)
If dstwk Is Nothing Then
   Set dstwk = Worksheets.Add(after:=ActiveSheet)
   dstwk.Name = Extract
End If
On Error GoTo 0
dstwk.Cells(1, id.Column) = "ID#"
acwk.Select
For i = 1 To UBound(ar)
   rng1.AutoFilter field:=1, Criteria1:=ar(i), Operator:=xlAnd
   Columns(id.Column).Hidden = True
   Set rng = id.CurrentRegion.SpecialCells(xlCellTypeVisible)
   Set dstrng = dstwk.Cells(Cells.Rows.count, id.Column) _
   .End(xlUp).Offset(1, 0)
   For Each r In rng.EntireRow
       If r.Row = id.Row Then
           dstrng = ar(i)
       Else
           Cells(r.Row, id.Column).Resize(1, cl).Copy _
           destination:=dstrng
       End If
       Set dstrng = dstwk.Cells(dstrng.Row, Cells.Columns.count) _
       .End(xlToLeft).Offset(0, 1)
   Next
Next
Columns(id.Column).Hidden = False
acwk.AutoFilterMode = False
dstwk.Select
End Sub

keizi

For a query solution solution try this:

1. Give the table the name "A" by selecting the whole table and typing
"A" in the name box next to the formula bar.

2. Choose Data > Import Data, select Files of type: Excel Files and
locate the workbook

3. Click OK and then Edit Query, Command Type: SQL and paste the
following into the Command Text Dialog then OK.

TRANSFORM First(Choose(D.index,C.account,C.status)) AS Expr1
SELECT C.[ID#]
FROM (SELECT A.[ID#], A.account, A.status, Sum(-(A.account &
A.status>=B.account & B.status)) AS [Index]
FROM A, A AS B
WHERE (((A.[ID#])=B.[ID#]))
GROUP BY A.[ID#], A.account, A.status) AS C, (SELECT A.[ID#],
A.account, A.status, Sum(-(A.account & A.status>=B.account & B.status))
AS [Index]
FROM A, A AS B
WHERE (((A.[ID#])=B.[ID#]))
GROUP BY A.[ID#], A.account, A.status) AS D
WHERE (((D.Index)<=2))
GROUP BY C.[ID#]
PIVOT C.index+D.index/10;

THis gives this output:

ID#    1_1    1_2    2_1    2_2    3_1    3_2
10    1    open
20    1    open
30    1    closed    2    transition    3    closed

(You can paste the various components of this into Access to see the
design layout.)