Subdividing 1 grouping of data into 6

[SolarBlue]

Hi

I have 2 columns of data that I have imported from a txt file. Column
is a date (dd-mmm-yy) and Column B is a time (hh:mm:ss)

i.e
A1= 26 Jan 04, B1= 19:45:33
A2= 25 Feb 04, B2= 04:13:12
A3=15 Mar 04, B3= 11:15:30
-- ---- --- -- -- --- --- ---
A12= 12 Dec 04, B12= 11:12:13
A13= 13 Jan 05, B13= 08:23:13
A14= 25 Feb 05, B14= 04:13:12
A15=15 Mar 05, B15= 11:15:30

And so on for 6 years worth.

Problem: Each year can have either 12 or 13 enteries, so I could end u
importing a minimum of 72 enteries, or maximum of 78.

I need a statement that can identify the 'year' of the cell in Column
and copy A1 and B1 into a new section of the worksheet, then drop dow
to A2. If A2 is from the same year as A1, then copy A2 and B2 righ
under where I put the previous entry. Keep doing this (for either 12 o
13 times), then when the cell has a year +1 (ie the next year), star
copying into a different section.
Stop when I get to a cell with nothing in it.
What I end up with is 6 new groupings, one for each year.
From here I can manipulate etc as required.

Any help would be greatly appreciated, as while I have a basi
understanding of simple macros, these 'conditional' loops and staement
are just beyond my current level of knowledge

 

[Tom Ogilvy]

Sub CopyData()
Dim j As Long, rw As Long
Dim oldDate As Long
Dim cell As Range
j = 6
rw = 1
oldDate = 0
For Each cell In Range("A1", Cells(Rows.Count, 1).End(xlUp))
If Year(cell) <> oldDate Then
oldDate = Year(cell)
j = j + 2
rw = 1
End If
cell.Resize(1, 2).Copy _
Destination:=Cells(rw, j)
rw = rw + 1
Next
End Sub

 

[Dave Peterson]

I think the hardest part is to know where you wanted to paste these things.

I put them in row 1 columns D&E, G&H, J&K, ....

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim destCell As Range
Dim TopRow As Long
Dim BotRow As Long
Dim iRow As Long

Set wks = ActiveSheet
With wks
Set destCell = .Range("a1")
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

TopRow = FirstRow
For iRow = FirstRow To LastRow
If Year(.Cells(iRow, "A").Value) _
= Year(.Cells(iRow + 1, "A").Value) Then
'do nothing
Else
BotRow = iRow
Set destCell = destCell.Offset(0, 3)
If destCell.Column < .Columns.Count - 1 Then
.Range(.Cells(TopRow, "A"), .Cells(BotRow, "b")).Copy _
Destination:=destCell
TopRow = iRow + 1
Else
MsgBox "Out of room!"
Exit Sub
End If
End If
Next iRow
End With

End Sub

The code just looks through the Year(value) in column A. It keeps track of the
toprow of a group and the bottom row of a group. When it finds a difference in
years, it does the copy|paste.