Hi

Depending on the date i.e. 05/12/05, I want to write in the column next
to it the quarter its in i.e. 2005 Q4

It needs to be quick as I have 24k rows in my sheet. Thanks

Here is my code, however it sorts it just into 2004 Q1 or 2003 Q4.

Code:

Sub GroupInQTR()
Dim Cell As Range

Columns("D:D").Select
Application.CutCopyMode = False
Selection.Copy
Columns("E:E").Select
Selection.Insert Shift:=xlToRight

Range("E1").Select
ActiveCell.FormulaR1C1 = "QTR"

Range("E2").Select

Do

If IsEmpty(ActiveCell) = False Then

' 2003

If ActiveCell = "01/10/2003" And ActiveCell <= "31/12/2003"
Then
ActiveCell.FormulaR1C1 = "2003 Q4"

' 2004

ElseIf ActiveCell = "01/01/2004" And ActiveCell <=
"31/03/2004" Then
ActiveCell.FormulaR1C1 = "2004 Q1"

ElseIf ActiveCell = "01/04/2004" And ActiveCell <=
"30/06/2004" Then
ActiveCell.FormulaR1C1 = "2004 Q2"

ElseIf ActiveCell = "01/07/2004" And ActiveCell <=
"30/09/2004" Then
ActiveCell.FormulaR1C1 = "2004 Q3"

ElseIf ActiveCell = "01/10/2004" And ActiveCell <=
"31/12/2004" Then
ActiveCell.FormulaR1C1 = "2004 Q4"


' 2005

ElseIf ActiveCell = "01/01/2005" And ActiveCell <=
"31/03/2005" Then
ActiveCell.FormulaR1C1 = "2005 Q1"

ElseIf ActiveCell = "01/04/2005" And ActiveCell <=
"30/06/2005" Then
ActiveCell.FormulaR1C1 = "2005 Q2"

ElseIf ActiveCell = "01/07/2005" And ActiveCell <=
"30/09/2005" Then
ActiveCell.FormulaR1C1 = "2005 Q3"

ElseIf ActiveCell = "01/10/2005" And ActiveCell <=
"31/12/2005" Then
ActiveCell.FormulaR1C1 = "2005 Q4"

' 2006

ElseIf ActiveCell = "01/01/2006" And ActiveCell <=
"31/03/2006" Then
ActiveCell.FormulaR1C1 = "2004 Q1"

ElseIf ActiveCell = "01/04/2006" And ActiveCell <=
"30/06/2006" Then
ActiveCell.FormulaR1C1 = "2004 Q2"

ElseIf ActiveCell = "01/07/2006" And ActiveCell <=
"30/09/2006" Then
ActiveCell.FormulaR1C1 = "2004 Q3"

ElseIf ActiveCell = "01/10/2006" And ActiveCell <=
"31/12/2006" Then
ActiveCell.FormulaR1C1 = "2004 Q4"

' For rest of the dates

ElseIf ActiveCell < "01/10/2003" Or ActiveCell "31/12/2006"
Then
ActiveCell.FormulaR1C1 = ""


End If

ElseIf IsEmpty(ActiveCell) = True Then GoTo MissKaka

End If

ActiveCell.Offset(1, 0).Select

Loop

MissKaka:
Range("A1").Select
MsgBox "All the period cells are now updates to a 'Quarter
Format'"

End Sub


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=475100