Split Rows into Multiple Sheets Using Date

[mewlz]

Hi guys,

I have a sheet contains 2 columns with the first column contain date & time (i.e. 23/03/2014 09:03).
I would like to separate different dates to a different sheets:

23/03/2014 09:03
23/03/2014 09:04
23/03/2014 09:05
24/03/2014 09:03
24/03/2014 09:04
24/03/2014 09:05

To be in 2 different sheets named 23/03/2014 & 24/03/2014.

Thank you very much for your kind help.

 

[farmerscott]

Will there only be these two dates? Are the sheets already named?

If there is more dates do you want the sheets automatically added or will you name them?

 

[mewlz]

There will be more than these two rows and each date would have more than 3 rows (so alot of rows).
The sheets havent been named...

 

[mirabeau]

Hi guys,

I have a sheet contains 2 columns with the first column contain date & time (i.e. 23/03/2014 09:03).
I would like to separate different dates to a different sheets:

23/03/2014 09:03
23/03/2014 09:04
23/03/2014 09:05
24/03/2014 09:03
24/03/2014 09:04
24/03/2014 09:05

To be in 2 different sheets named 23/03/2014 & 24/03/2014.

Thank you very much for your kind help.

Some characters are not allowable as part of sheet names.

/ is one of these

would you like your new sheets to be named in an allowable date format such as 23-03-2014?

 

[mirabeau]

so, perhaps something like this

Sub new_sheets()

Dim c As Long, j As Long

With ActiveSheet.Cells(1).CurrentRegion
    .Sort Cells(1)
    With .Resize(.Rows.Count + 1)
    c = 1
    For j = 1 To .Rows.Count + 1
        If Int(.Cells(j, 1)) <> Int(.Cells(c, 1)) Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = Format(Int(.Cells(c, 1)), "dd-mm-yyyy")
            .Rows(c).Resize(j - c).Copy Cells(1)
            Columns.AutoFit
            c = j
        End If
    Next j
    End With
End With

End Sub

 

[mewlz]

Thank you for this - it works wonder

I have just noticed after doing this it seems that I have a lot of duplicated rows.

For example:

Date | Number
23/03/2014 09:03 | 5
23/03/2014 09:05 | 5
23/03/2014 09:05 | 1
24/03/2014 09:03 | 2
24/03/2014 09:03 | 1
24/03/2014 09:05 | 3

Is there anyway on top of separating each date to different sheet but also to sum the column 'number' with the same timestamp to look more like:

Sheet 23/03/2013:
Date | Number
23/03/2014 09:03 | 5
23/03/2014 09:05 | 6

Sheet 24/03/2014:
Date | Number
24/03/2014 09:03 | 3
24/03/2014 09:05 | 3

Thank you in advanced for your help!

 

[mirabeau]

Thank you for this - it works wonder

I have just noticed after doing this it seems that I have a lot of duplicated rows.

For example:

Date | Number
23/03/2014 09:03 | 5
23/03/2014 09:05 | 5
23/03/2014 09:05 | 1
24/03/2014 09:03 | 2
24/03/2014 09:03 | 1
24/03/2014 09:05 | 3

Is there anyway on top of separating each date to different sheet but also to sum the column 'number' with the same timestamp to look more like:

Sheet 23/03/2013:
Date | Number
23/03/2014 09:03 | 5
23/03/2014 09:05 | 6

Sheet 24/03/2014:
Date | Number
24/03/2014 09:03 | 3
24/03/2014 09:05 | 3

Thank you in advanced for your help!

try this modified version
it makes no allowance for sheet headers since I don't know the specific structure of your data
but you can easily remove any headers from your initial sheet and re-insert them as appropriate later. or the code can do it easily if you can be more specific about your data structure

Sub new_sheets2()

Dim c As Long, j As Long, d As Object, q
Set d = CreateObject("scripting.dictionary")

With ActiveSheet.Cells(1).CurrentRegion
    .Sort Cells(1)
    With .Resize(.Rows.Count + 1)
    c = 1
    For j = 1 To .Rows.Count + 1
        If Int(.Cells(j, 1)) <> Int(.Cells(c, 1)) Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = Format(Int(.Cells(c, 1)), "dd-mm-yyyy")
            .Rows(c).Resize(j - c).Copy Cells(1)
            d.RemoveAll
            With Cells(1).CurrentRegion
                For Each q In .Resize(, 1)
                    d(q.Value) = d(q.Value) + q.Offset(, 1).Value
                Next q
                .ClearContents
                .Cells(1).Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
            End With
            Columns.AutoFit
            c = j
        End If
    Next j
    End With
End With

End Sub