PDA

View Full Version : VBA Macro for copy dates in new sheet(s)



JohnWaveDoe
03-21-2012, 07:26 AM
Hi all,

I'm very new in VBA and Excel macros,
I need someone to expain me how I can compare dates from Sheet1, Column A, (dates are sorted asc) and if new range of dates are "newer" than previous, then copy that range in new sheet which is dynamically created and have name of date.

That means, that output is sheet1.range("A") is header (DateTime) and sorted dates.
And other sheets with name of unique date and in range of that dates from first sheet.

Example input: Example output:
SheetName:03.10.08. SheetName:04.10:08. etc.
DateTime DateTime DateTime etc.
--------- --------- ---------
03.10.08. 08:22:13 03.10.08. 08:22:13 04.10.08. 08:25:13 etc.
03.10.08. 08:25:13 03.10.08. 08:25:13
04.10.08. 08:25:13
05.10.08. 08:34:13

Kenneth Hobs
03-21-2012, 09:55 AM
Welcome to the forum!

It is a bit hard to see what you mean. You need 5 posts before you can attach a file. Sites like box.net can be used if you want to share a file before you get 5 posts. The more simple the example, the easier it is to help. Be sure to show the before and after results.

JohnWaveDoe
03-22-2012, 03:55 AM
The question is not that hard to understand.

And I think that solution is very easy, but I don't know VBA very well.

So again, In excel workbook, I have only one sheet (input) with only one column (Date_Time) where data is sorted. Now, There can be multiple rows with same Date (time is irrelevant) (FORMAT etc: 03.10.08. 08:22:13 or
DD.MM.YY. HH.MM.SS).

All I want is to create new sheets (from that one input sheet) which have data on same date, and name of sheet is date. (etc. SheetName = "DD.MM.YY." and data in it is all input rows in same date (NOT time))

PS: Data is in Date format in excel

Thx in advance and sorry for previous confusing question.

CatDaddy
03-22-2012, 11:01 AM
Sub sortSheets()
Dim cell As Range
Dim sht As Worksheet
Dim s As Integer
For Each cell In Range("A2:A" & Range("A65536").End(xlUp).Row)
s = 0
For Each sht In ActiveWorkbook.Worksheets

If InStr(Left(cell.Text, 8), sht.Name) Then
cell.EntireRow.Copy Destination:=Sheets(sht.Name).Range("A65526").End(xlUp).Offset(1, 0)
s = 1
End If
Next sht

If s = 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Left(cell.Text, 8)
cell.EntireRow.Copy Destination:=Sheets(Sheets.Count).Range("A1")
End If

Next cell
End Sub