PDA

View Full Version : Solved: Sorting by month of year



marshybid
05-27-2008, 02:08 AM
Hi All,

I have a macro that adds a column in my base data showinmg the month that an activity took place (year is not important as the base data is only collected for one year)

I then want to sort the data by the month column, so I have added the following code



Selection.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select


The issue is that this sorts the column alphabetically, so: Apr, Feb, Mar, May etc

I would like to be able to sort the data by month of year i.e. Jan, Feb, Mar etc

Can anyone please help.

Thanks,

Marshybid :help

JimmyTheHand
05-27-2008, 02:33 AM
Change the macro so that it fills column "J" with actual dates, instead of month names, then change the numberformat of column J so that it shows month names.
Range("J:J").NumberFormat = "mmmm" This way the displayed values will be Apr, Feb, Mar, May, etc, but the sort will be done based on the underlying date.

HTH

Jimmy

marshybid
05-27-2008, 02:48 AM
OK, so instead of this code



Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",TEXT(RC[-1],""MMM""))"

Selection.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select


I should have this code??



Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",MONTH(RC[-1]))"

Selection.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Range("J:J").NumberFormat = "mmmm"


Is this correct??

Thanks,

Marshybid

Bob Phillips
05-27-2008, 03:04 AM
The Numberformat line is irrelevant as long as you have a numeric month column not text.

Bob Phillips
05-27-2008, 03:06 AM
Also, shouldn't you copy that formula down the column.

JimmyTheHand
05-27-2008, 03:13 AM
Well, without seeing the workbook and the full code, my guess would be this:

Range("J2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]"
ActiveCell.NumberFormat = "mmmm"

Selection.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal




I would probably end up with something like this:
with Range("J2")
.Formula = "=I2"
.NumberFormat = "mmmm"
.CurrentRegion.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End With

Of course, I can't be sure, because the layout of your worksheet can be different from what I imagine.

Jimmy

marshybid
05-27-2008, 03:14 AM
Hi xld,

See below the full code for this part of the macro



Range("J1").Select
ActiveCell.FormulaR1C1 = "Month Submitted"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",TEXT(RC[-1],""MMM""))"
Range("J2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
Cells.Select
Selection.RowHeight = 15
Cells.Select
Selection.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select


I will amend to show numeric Month, but I do need to change it back just for reviewing purposes, it is easier to read the month as Jan, Feb etc rather 01, 02 etc.

Thanks,

Marshybid

marshybid
05-27-2008, 03:26 AM
Thanks JimmyTheHand for your help.

I am posting the full code plus an example spreadsheet.

For some reason I am losing row 1 (headers) when I run the macro??



Sub CycleTime()
'
' CycleTime Macro
' Macro recorded 5/15/2008 by Richard Francis
'
'
ActiveSheet.Name = "Cycle Times"
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Columns("N:N").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=2
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=2
Columns("T:T").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=2
Columns("W:W").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=2
Columns("Z:Z").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=1
Columns("AC:AC").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=4
Columns("AF:AF").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=3
Columns("AI:AI").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=2
Columns("AK:AM").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.LargeScroll ToRight:=-7
Range("K1").Select
ActiveCell.FormulaR1C1 = "Request Submitted Elapsed Time"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-2])"
Range("K2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1/1/1900 12:00:00 AM"
Selection.End(xlUp).Select
ActiveCell.Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveCell.Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False
Selection.NumberFormat = "d:h:m"
ActiveCell.Select
Range("L1").Select
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("N1").Select
Selection.Copy
Range("M1").Select
ActiveSheet.Paste
Range("M2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
Range("M2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
ActiveCell.Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False
Selection.NumberFormat = "d:h:m"
Selection.ColumnWidth = 16.14
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Range("P1").Select
Selection.Copy
Range("O1").Select
ActiveSheet.Paste
Range("O2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
Columns("O:O").Select
Selection.NumberFormat = "d:h:m"
Range("O2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1/1/1900 12:00:00 AM"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Columns("P:P").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("R1").Select
Selection.Copy
Range("Q1").Select
ActiveSheet.Paste
Range("Q2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
Columns("Q:Q").Select
Selection.NumberFormat = "d:h:m"
Range("Q2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1/1/1900 12:00:00 AM"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
Columns("R:R").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll ToRight:=2
Range("T1").Select
Selection.Copy
Range("S1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=-3
Range("S2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
Range("S2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
Columns("T:T").Select
Selection.Delete Shift:=xlToLeft
Range("V1").Select
Selection.Copy
Range("U1").Select
ActiveSheet.Paste
Range("U2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
Range("U2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
Columns("V:V").Select
Selection.Delete Shift:=xlToLeft
Range("X1").Select
Selection.Copy
Range("W1").Select
ActiveSheet.Paste
Range("W2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
Range("W2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, 2).Range("A1").Select
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
ActiveCell.Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Columns("Z:Z").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("AB1").Select
Selection.Copy
Range("AA1").Select
ActiveSheet.Paste
Range("AA2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",RC[-1]-RC[-3])"
Range("AA2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
Columns("AB:AB").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll ToRight:=3
Range("AE1").Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-2
Range("AB1").Select
ActiveSheet.Paste
Range("AB2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=SUM(R[-1]C[-17],R[-1]C[-15],R[-1]C[-13],R[-1]C[-11],R[-1]C[-9],R[-1]C[-7],R[-1]C[-5],R[-1]C[-3],R[-1]C[-1])"
Columns("AB:AB").Select
Selection.NumberFormat = "d:h:m"
Columns("AA:AA").Select
Selection.NumberFormat = "d:h:m"
Range("AB2").Select
ActiveCell.Offset(0, -2).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.FormulaR1C1 = "1/1/1900 12:00:00 AM"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
ActiveCell.Offset(0, 3).Range("A1").Select
Columns("AE:AE").Select
Selection.Delete Shift:=xlToLeft
Range("AE1").Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-1
Range("AC1").Select
ActiveSheet.Paste
Range("AC2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AB-AD"
Columns("AC:AC").Select
Selection.NumberFormat = "d:h:m"
Range("AC2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1/1/1900 12:00:00 AM"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
Columns("AE:AE").Select
Selection.Delete Shift:=xlToLeft
Range("AE1").Select
Selection.Copy
Range("AD1").Select
ActiveSheet.Paste
Range("AD2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AA"
Range("AD3").Select
ActiveWindow.SmallScroll ToRight:=0
Range("AD2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveCell.Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False
Selection.NumberFormat = "d:h:m"
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.LargeScroll Down:=3
ActiveWindow.LargeScroll ToRight:=-1
Range("AC84").Select
ActiveWindow.SmallScroll ToRight:=2
Range("AD84").Select
ActiveWindow.SmallScroll ToRight:=0
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=(AA)"
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=IF(AA="" "","" "",AA)"
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=(R[-1]C[-3])"
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=(RC[-3])"
Range("AC2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[1]"
Range("AC2").Select
ActiveWindow.SmallScroll ToRight:=-1
Range("AD2").Select
ActiveCell.Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Range("A1").Select
Application.CutCopyMode = False
ActiveCell.Offset(1, -1).Range("A1").Select
ActiveWindow.SmallScroll ToRight:=-2
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""0:0:0"","" "",RC[-1]-RC[1])"
Range("AC2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""0"","" "",RC[-1]-RC[1])"
Columns("AC:AC").Select
Selection.NumberFormat = "d:h:m"
Range("AC2").Select
ActiveWindow.SmallScroll ToRight:=1
ActiveCell.FormulaR1C1 = "=IF(RC[1]="" "","" "",RC[-1]-RC[1])"
Range("AC2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("AC1").Select
Application.CutCopyMode = False
ActiveWindow.LargeScroll ToRight:=1
Range("K:K,M:M,O:O").Select
Range("O1").Activate
ActiveWindow.SmallScroll ToRight:=3
Range("K:K,M:M,O:O,Q:Q").Select
Range("Q1").Activate
ActiveWindow.SmallScroll ToRight:=5
Range("K:K,M:M,O:O,Q:Q,S:S,U:U").Select
Range("U1").Activate
ActiveWindow.SmallScroll ToRight:=3
Range("K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y").Select
Range("Y1").Activate
ActiveWindow.SmallScroll ToRight:=4
Range("K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA,AB:AB").Select
Range("AB1").Activate
ActiveWindow.SmallScroll ToRight:=3
Range("K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA,AB:AB,AC:AC,AD:AD").Select
Range("AD1").Activate
Selection.NumberFormat = "d:h:m"
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
ActiveCell.FormulaR1C1 = "Month Submitted"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",TEXT(RC[-1],""MMM""))"
Range("K2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("J1").Select
ActiveCell.FormulaR1C1 = "Month Submitted"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""<Null>"","" "",MONTH(RC[-1]))"
Range("J2").Select
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Selection.End(xlUp).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Application.CutCopyMode = False
ActiveCell.Columns("J:J").EntireColumn.Select
Application.CutCopyMode = False
Selection.NumberFormat = "MMM"
Cells.Select
Selection.RowHeight = 15
Cells.Select
Selection.Sort Key1:=Range("J1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
End Sub


The manner in which the original data is formatted means that I can not use the information (cycle times) to analyse etc, so the macro formats each set of data correctly. I also then need to sort and filter this data by Month created and Month submitted etc.

All help gratefully received.

Marshbid

Bob Phillips
05-27-2008, 03:38 AM
I can't follow that. It has all that selecting, and odd ways of determing where to copy data to.

Maybe set header to xlYes not xlGuess (but that is a guess).

marshybid
05-27-2008, 04:07 AM
Hi xld,

Unfortunately this was the only way that I could find to add all of the additional columns with the correct formula and formatting then delete the columns no longer needed.

As you will see in the example 1 spreadsheet, there are a lot of columns of data that are in an unusable format.

As you know, my knowledge/experience of VB is very limited, so I tend to record myself doing something once then repeat that step for other columns etc that need the same process.

Thanks for your help.

Marshybid

mikerickson
05-27-2008, 06:14 AM
If column J contains serial dates (General format =39595) then this will sort the .CurrentRegion by those dates by month.
With Range("j2").EntireColumn
With Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
.EntireColumn.Insert

.Offset(0, -1).FormulaR1C1 = "=TEXT(RC[1],""mmm"")"

.CurrentRegion.Sort Key1:=.Range("a1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=4, MatchCase:=False, Orientation:=xlTopToBottom

.Offset(0, -1).EntireColumn.Delete
End With
End With
If column J contains text of the month name only (eg. "Mar", "Dec","...) the inserted helper column and formula is not needed. Sorting by the custom list order #4 will work on its own.

If you have other text in column J, eg ("Jan 14, 2003") then the formula in the above can be modified to return only mmm strings.

marshybid
05-27-2008, 06:32 AM
Thanks Mikerickson. I'll try this out this afternoon.

I will mark this thread as solved.

Thanks to all for your help. :hi: