Sorting problem : "The sort reference is not valid..........."
My program merges and appends transposed data from Sheets "Force" &
"Hours" in Workbook "Src" to Workbook "Dest"
In the following example, Project Z already exists in the destination
Workbook and Project Y is properly appended.
Note : Worksheets "Force" & "Hours" have the same mapping in Rows &
Cols.
The writing in the destination Workbook "Dest" works fine up to that
point.
The next step is to sort in the destination workbook, the original
data which was already there
Project Z inclusive of the new appended Project Y.
The current region (A2 to E17) has to be sorted by Project and Date.
After sorting Project Y should come before Project Z.
but an error is generated on the sort line.
For some reason the current region range is not taken into account, or
something else.
Help appreciated.
..
Data Source : Workbook : "Src" . Sheet1 "Force" Path C:\Work\
.................................................. ............................................
A B C D E
1 Project Y 9/28/2010 9/29/2010 9/30/2010 10/1/2010
2 Task J 4 2 1
3 Task K 7 10 11
4 Task L 6 15 12
5. Total 10 22 12 24
..
Data Source : Workbook : "Src" Sheet2 "Hours" Path C:\Work\
.................................................. .........................................
1 Project Y 9/25/2010 9/26/2010 9/27/2010 9/28/2010
2 Task J 200 0 100 50
3 Task K 0 350 500 550
4 Task L 300 750 0 600
5 Total 500 1100 600 1200
..
Data Destination : Workbook "Dest" Sheet1 Path C:\Work\
.................................................. .........................................
1 Date Project Activity Force Hours
2 9/27/2010 Project Z Task F 4 200
3 9/27/2010 Project Z Task F 6 300
4 9/28/2010 Project Z Task G 7 350
5 9/28/2010 Project Z Task H 15 750
6 9/29/2010 Project Z Task F 2 100
7 9/29/2010 Project Z Task H 10 500
8 9/30/2010 Project Z Task F 1 50
9 9/30/2010 Project Z Task G 11 550
10 9/30/2010 Project Z Task H 12 600
11 9/28/2010 Project Y Task J 4 200
12 9/28/2010 Project Y Task L 6 300
13 9/29/2010 Project Y Task K 7 350
14 9/29/2010 Project Y Task L 15 750
15 9/30/2010 Project Y Task J 2 100
16 9/30/2010 Project Y Task K 10 500
17 10/1/2010 Project Y Task J 1 50
18 10/1/2010 Project Y Task K 11 550
19 10/1/2010 Project Y Task L 12 600
.................................................. ............................................
Sub ReorgData()
Dim SrcWB, DestWB As Workbook
Dim SrcSHa, SrcSHb, DestSh As Worksheet
Dim DestCell As Range
Dim LastCol, LastRow, DestLastRow As Long
Dim SrcPath, DestPath As String
On Error GoTo ErrorCatch
SrcPath = "C:\1-Work\"
DestPath = "C:\1-Work\"
Application.ScreenUpdating = False
Set SrcWBa = Workbooks.Open(SrcPath & "Src.xls")
Set DestWB = Workbooks.Open(DestPath & "Dest.xls")
Set SrcSHa = SrcWBa.Worksheets("Sheet1")
Set SrcSHb = SrcWBa.Worksheets("Sheet2")
Set DestSh = DestWB.Worksheets("Sheet1")
' Find next row to Append
LastRow = SrcSHa.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = SrcSHa.Cells(1, Columns.Count).End(xlToLeft).Column
DestLastRow = DestSh.Cells(Rows.Count, 1).End(xlUp).Row
Set DestCell = DestSh.Range("A" & DestLastRow)
Set DestCell = DestCell.Offset(1, 0)
For c = 2 To LastCol
For r = 2 To LastRow
' Write DestWB Sheet1
If SrcSHa.Cells(r, 1) < "Total" Then ' Excludes
Total Row
If SrcSHa.Cells(r, c) < "" Then
DestCell = SourceSHa.Cells(1, c)
'A = Date
DestCell.Offset(0, 1) = SourceSHa.Cells(1, 1) 'B =
Project
DestCell.Offset(0, 2) = SourceSHa.Cells(r, 1) 'C =
Activity
' From "Force" sheet
DestCell.Offset(0, 3) = SourceSHa.Cells(r, c) 'D =
Force
' From "Hours" sheet
DestCell.Offset(0, 4) = SourceSHb.Cells(r, c) 'E =
Hours
Set DestCell = DestCell.Offset(1, 0)
End If
Else
r = LastRow
End If
Next
Next
DestSh.Range("A2").CurrentRegion.Sort Key1:=Range("B2"),
Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, Header:=xlGuess,
OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
ErrorCatch:
MsgBox Err.Description ' "The sort reference is not valid..........."
Exit Sub
Columns("A:A").Selection.NumberFormat = "m/d/yyyy"
Application.ScreenUpdating = True
SrcWBa.Close SaveChanges:=False
DestWB.Close SaveChanges:=True
End Sub


..