splitting a long column of data into separate columns

Hello, i have a long column pair of data, each entry in its own cell:

10/5/2008 8:30:00 AM
10/5/2008 8:46:00 AM
10/5/2008 9:14:00 AM
10/5/2008 10:18:00 AM
10/5/2008 10:42:00 AM
11/5/2008 8:30:00 AM
11/5/2008 8:46:00 AM
11/5/2008 9:14:00 AM
11/5/2008 10:18:00 AM
11/5/2008 10:42:00 AM
12/5/2008 8:30:00 AM
12/5/2008 8:46:00 AM
12/5/2008 9:14:00 AM
12/5/2008 10:18:00 AM
12/5/2008 10:42:00 AM
13/5/2008 8:30:00 AM
13/5/2008 8:46:00 AM
13/5/2008 9:14:00 AM
13/5/2008 10:18:00 AM
13/5/2008 10:42:00 AM
14/5/2008 8:30:00 AM
14/5/2008 8:46:00 AM
14/5/2008 9:14:00 AM
14/5/2008 10:18:00 AM
14/5/2008 10:42:00 AM

how can i program a macro to 'split' this column according to date? please refer to the attached picture as an example. i know this is probably a simple question but please bear with me i'm still new to excel programming.

thanks in advance!

Hi, Give this a try:-
The resutant date formats are not quite correct may be my "country setting"
Have a go, see what you find.
Data in column "A". Results in column "B" on--.

Dim Last As Integer, Oday As Integer, oMk, oFst, OLst, Dn, Ac
Last = Range("a" & Rows.Count).End(xlUp).Row
Ac = 2
For Oday = 1 To Last
    If IsDate(Cells(Oday, 1).Value) Then
        oMk = Left(Cells(Oday, 1).Value, 2)
    Do While Left(Cells(Oday, 1).Value, 2) = oMk
            Dn = Dn + 1
        oFst = Split(Cells(Oday, 1).Value, " ")(0)
            OLst = Split(Cells(Oday, 1).Value, " ")(1)
                Cells(Dn, Ac).Value = oFst
                    Cells(Dn, Ac + 1).Value = OLst
                    Oday = Oday + 1
                Loop
    Ac = Ac + 2
      Oday = Oday - 1
        Dn = 0
 End If
Next Oday

Regards mick

Try this one. Be aware that everything is processed from bottom to top. Normally it would be start,stop time but in reverse it's stop, start.

Sub split_data_of_day()
'last row of data
Dim lrow As Long
'actual row that is being processed
Dim countlrow As Long
'datevalue
Dim myvalue As Date
'workbook
Dim wb As Workbook
'the worksheet
Dim ws As Worksheet
Set wb = ThisWorkbook
'check every worksheet
For Each ws In wb.Worksheets
    Select Case ws.Name
'if different then ... don't do a thing
        Case "Sheet1", "Sheet2", "Sheet3"
        Case Else
'process the individual shees
        With wb.Worksheets(ws.Name)
             myvalue = "00:00:00"
             lrow = .Range("A" & .Rows.Count).End(xlUp).Row
             For countlrow = lrow To 2 Step -1
'check if myvalue is different. if so, insert two columns
                 If myvalue <> .Range("A" & countlrow).Value Then
                     .Range("C:C").EntireColumn.Insert
                     .Range("C:C").EntireColumn.Insert
                     .Range("A" & countlrow).Resize(, 2).Copy
                     .Range("C" & .Range("C" & _
                     Rows.Count).End(xlUp).Offset(1, 0).Row).PasteSpecial xlPasteAll
                 Else
'if time is same, just copy data
                     .Range("A" & countlrow).Resize(, 2).Copy
                     .Range("C" & .Range("C" & _
                     Rows.Count).End(xlUp).Offset(1, 0).Row).PasteSpecial xlPasteAll
                 End If
             myvalue = .Range("A" & countlrow).Value
             Next countlrow
'remove column A and B
             Application.DisplayAlerts = False
             .Range("A:B").EntireColumn.Delete
             Application.DisplayAlerts = True
         End With
    End Select
Next ws
End Sub

Charlize

After some revision of another idea, I came up with this one. I believe it's what you desire.

Sub split_data_of_day_V2()
'last row of data
Dim lrow As Long
'actual row that is being processed
Dim countlrow As Long
'current column
Dim curcolumn As Long
'letter of column as string
Dim vletter As String
'datevalue
Dim myvalue As Date
'workbook
Dim wb As Workbook
'the worksheet
Dim ws As Worksheet
Set wb = ThisWorkbook
'check every worksheet
For Each ws In wb.Worksheets
    Select Case ws.Name
'if different then ... don't do a thing
        Case "Sheet1", "Sheet2", "Sheet3"
        Case Else
'process the individual shees
        With wb.Worksheets(ws.Name)
             myvalue = "00:00:00"
             curcolumn = 1
             lrow = .Range("A" & .Rows.Count).End(xlUp).Row
             For countlrow = 2 To lrow Step 1
'check if myvalue is different. if so, shift up two columns
                 If myvalue <> .Range("A" & countlrow).Value Then
                     curcolumn = curcolumn + 2
'get the columnletter to where we need to paste the info
                     vletter = Split(Cells(1, curcolumn).Address, "$")(1)
                     .Range("A" & countlrow).Resize(, 2).Copy
                     .Range(vletter & .Range(vletter & _
                        Rows.Count).End(xlUp).Offset(1, 0).Row).PasteSpecial xlPasteAll
                 Else
'if time is same, just copy and paste data
                     .Range("A" & countlrow).Resize(, 2).Copy
                     .Range(vletter & .Range(vletter & _
                        Rows.Count).End(xlUp).Offset(1, 0).Row).PasteSpecial xlPasteAll
                 End If
             myvalue = .Range("A" & countlrow).Value
             Next countlrow
'remove column A and B
             Application.DisplayAlerts = False
             .Range("A:B").EntireColumn.Delete
             Application.DisplayAlerts = True
         End With
    End Select
Next ws
End Sub

Charlize

.Range(vletter & .Range(vletter & _
Rows.Count).End(xlUp).Offset(1, 0).Row).PasteSpecial xlPasteAll

i'm getting this error: Application-defined or Object-defined error

but it's been a long day and my head's melting, so perhaps it's an error on my side. will try again tomorrow, update how it goes.

thanks again charlize, don't know what i'd do without you.

~Michael