Split File

**pr4t3ek** · 12-15-2008, 08:12 PM

QB03654338 AGLQLD2 10/06/2007 0:00 14/02/2008 0:00
QB03654338 AGLQLD2 15/02/2008 0:00 10/04/2008 0:00
QB03654338 AGLQLD2 19/08/2008 0:00 31/12/9999 0:00

to this:

QB03654338 AGLQLD2 10/06/2007 0:00 14/02/2008 0:00 15/02/2008 0:00 10/04/2008 0:00 19/08/2008 0:00 31/12/9999 0:00

So adding it to all to one line if it is the same ID number "QB03654338"

Please see the attached file

**rylo** · 12-15-2008, 08:55 PM

Hi

In your exampe file add a new sheet and rename it to OutPut.

Then run the code

Sub aaa()
  Dim OutSH As Worksheet, NMI As Variant
  Set OutSH = Sheets("OutPut")
  OutSH.Cells.ClearContents
  Sheets("NEED TO FIX").Activate
  OutSH.Range("A1:D1").Value = Range("A1:D1").Value
  NMI = ""
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    Application.StatusBar = i
    If Cells(i, 1).Value = NMI Then
      outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Row
      Cells(i, 1).Offset(0, 2).Resize(1, 2).Copy Destination:=OutSH.Cells(outrow, Columns.Count).End(xlToLeft).Offset(0, 1)
    Else
      Cells(i, 1).Resize(1, 4).Copy Destination:=OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
      NMI = Cells(i, 1).Value
    End If
  Next i
  Application.StatusBar = False
  MsgBox "Done"
End Sub

rylo