Code Change

[blumfeld0]

I have a file called data.xls. I hope someone can address the 2 small ( i hope) changes i need to make to the macro. the file is 2mb so i couldnt upload it. i did upload it to the link below.
basically, once you click the "arrange data" button in the file the data is organized by the letter found in column B and then by the year found in column C.
I need the exact reverse. First sort the data by the year in column C and then by the letter found in column B.
i hope someone can help.

http://www.speedyshare.com/566234624.html

thank you!

[Simon Lloyd]

Blumfeld, i suggest you look at the macro's contained in the workbook and find the section that sorts the data by columns and post that particular code!, you will probably find that making changes through trial and error with this section will achieve what you want.

When uploading work to this site you do not need to include all the data or worksheets in the workbook, just enough information to show us what you are trying to achieve is enough, more often than not the people who help on this site can normally give you a solution or suggestion just by seeing your code which you can add to your thread.

[Bob Phillips]

[VBA]

Selection.CurrentRegion.Select
On Error GoTo cancelled
Set UserRange = Application.InputBox("Confirm or adjust the range to process (include the headers)", "Confirm range to process", Selection.Address, , , , , 8)
On Error GoTo 0
With UserRange
.Sort Key1:=.Range("c4"), _
Order1:=xlAscending, _
Key2:=.Range("B4"), _
Order2:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Set myheaders = UserRange.Rows(1)
[/VBA]

[blumfeld0]

thank you.
the code is:


Sub DoIt()
Selection.CurrentRegion.Select
On Error GoTo cancelled
Set UserRange = Application.InputBox("Confirm or adjust the range to process (include the headers)", "Confirm range to process", Selection.Address, , , , , 8)
UserRange.Select
On Error GoTo 0
Selection.Sort Key1:=Selection.Range("B4"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Set myheaders = Selection.Rows(1)

Selection.Rows("2:" & Selection.Rows.Count).Select
SelTopRow = Selection.Row
SelWidth = Selection.Columns.Count
batchno = 0
rw = 1
startrow = 1
Do Until rw > Selection.Rows.Count
Do Until Selection.Cells(startrow, 2) <> Selection.Cells(rw + 1, 2)
rw = rw + 1
Loop
If batchno > 0 Then
Set mysource = Selection.Rows(startrow & ":" & rw)
Set myDest = Selection.Cells(1, 1).Offset(, batchno * (SelWidth + 1)).Resize(rw - startrow + 1, SelWidth)
mysource.Copy myDest
mysource.Clear
Set myDest = myDest.Rows(1).Offset(-1)
myheaders.Copy myDest
thisDepth = myDest.Cells(1).End(xlDown).Row - myDest.Row
lastDepth = myDest.Cells(1).Offset(, -2).End(xlDown).Row - myDest.Row
blackDepth = WorksheetFunction.Max(thisDepth, lastDepth)
myDest.Cells(1).Offset(, -1).Resize(blackDepth + 1).Interior.ColorIndex = 1
myDest.Cells(1).Offset(, -1).ColumnWidth = 10#
myDest.EntireColumn.AutoFit
End If
rw = rw + 1: startrow = rw: batchno = batchno + 1
Loop
cancelled:
End Sub






Sub Macro1()
'
' Macro1 Macro
' Macro recorded 17/09/2007 by Pascal
'

'
Columns("AK:AR").Select
Columns("AK:AR").EntireColumn.AutoFit
End Sub
Sub Macro2()
'
' Macro2 Macro
' Macro recorded 17/09/2007 by Pascal
'

'
Range("AJ3:AJ10").Select
Selection.Interior.ColorIndex = 1
Columns("AJ:AJ").Select
Selection.ColumnWidth = 1.57
End Sub
Sub Macro3()
'
' Macro3 Macro
' Macro recorded 17/09/2007 by Pascal
'

'
Selection.CurrentRegion.Select
End Sub



I replaced

Selection.CurrentRegion.Select
On Error GoTo cancelled
Set UserRange = Application.InputBox("Confirm or adjust the range to process (include the headers)", "Confirm range to process", Selection.Address, , , , , 8)
UserRange.Select
On Error GoTo 0
Selection.Sort Key1:=Selection.Range("B4"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Set myheaders = Selection.Rows(1)


with your code xld. and it did not compile. i got error message when trying to run the macro.
it says "compile error", "expected end with"


thanks

[p45cal]

try:
[vba]Sub DoIt()
Selection.CurrentRegion.Select
On Error GoTo cancelled
Set UserRange = Application.InputBox("Confirm or adjust the range to process (include the headers)", "Confirm range to process", Selection.Address, , , , , 8)
UserRange.Select
On Error GoTo 0
'Selection.Sort Key1:=Selection.Range("B4"), Order1:=xlAscending, Header:=xlYes, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
' DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
'pd changed line below
Selection.Sort Key1:=Range("C15"), Order1:=xlAscending, Key2:=Range("B15" _
), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal

Set myheaders = Selection.Rows(1)

Selection.Rows("2:" & Selection.Rows.Count).Select
SelTopRow = Selection.Row
SelWidth = Selection.Columns.Count
batchno = 1 'pd changed
Rw = 1
startrow = 1
Do Until Rw > Selection.Rows.Count
Do Until Selection.Cells(startrow, 2) <> Selection.Cells(Rw + 1, 2) Or _
Selection.Cells(startrow, 3) <> Selection.Cells(Rw + 1, 3) Or Rw > Selection.Rows.Count 'pd changed
Rw = Rw + 1
Loop
If Selection.Rows(startrow).Cells(2) <> "" Then 'batchno > 0 Then 'pd changed
Set mysource = Selection.Rows(startrow & ":" & Rw)
Set myDest = Selection.Cells(1, 1).Offset(, batchno * (SelWidth + 1)).Resize(Rw - startrow + 1, SelWidth)
mysource.Copy myDest
mysource.Clear
Set myDest = myDest.Rows(1).Offset(-1)
myheaders.Copy myDest
thisDepth = myDest.Cells(1).End(xlDown).Row - myDest.Row
lastDepth = myDest.Cells(1).Offset(, -2).End(xlDown).Row - myDest.Row
blackDepth = WorksheetFunction.Max(thisDepth, lastDepth)
myDest.Cells(1).Offset(, -1).Resize(blackDepth + 1).Interior.ColorIndex = 1
myDest.Cells(1).Offset(, -1).ColumnWidth = 12#
myDest.EntireColumn.AutoFit
End If
Rw = Rw + 1: startrow = Rw: batchno = batchno + 1
Loop
Selection.Offset(-1).Resize(Selection.Rows.Count + 1, Selection.Columns.Count + 1).Delete Shift:=xlToLeft 'pd added

cancelled:
End Sub[/vba]I've added 'pd added' or 'pd changed' in the code. Your sub did not take account of the possibiity of the same letter for different years being lumped together - that is addressed now.

[blumfeld0]

thanks one again p45cal!

blumfeld0