Sorting problem : "The sort reference is not valid..........."

[u473]

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


..

 

[Dave Peterson]

I didn't look at all your code, but this portion:

DestSh.Range("A2").CurrentRegion.Sort Key1:=Range("B2"),
Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, Header:=xlGuess,
OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

has some qualified ranges (destsh.range()...) and some unqualified ranges.

I'd try:

DestSh.Range("A2").CurrentRegion.Sort _
Key1:=DestSh.Range("B2"),Order1:=xlAscending, _
Key2:=DestSh.Range("A2"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom

Without those worksheet references, the unqualified ranges will refer to the
activesheet (if the code is in a General Module) or the worksheet that owns the
code (if the code is behind a worksheet).

It's always a good idea to qualify the ranges so you don't have to worry.

 

[u473]

Thank you, you made my day. It works
..
Last question, why do after the following statements
SrcWBa.Close SaveChanges:=False
DestWB.Close SaveChanges:=True
...When I click X to close, I still have a prompt that asks me
"Do you want to save the changes you made to Dest.xls
and my Source Workbook "Src" is still open.
I thought those statements were taking of closing :
False for do not Save and Close
True for Save and Close
have a good day,
J.P.

 

[Dave Peterson]

I don't see my response (yet). This is a copy.

First, you have some problems with your variables.

The "minor" stuff first.

These lines declare DestWB as a workbook and DestSh as a worksheet.
Dim SrcWB, DestWB As Workbook
Dim SrcSHa, SrcSHb, DestSh As Worksheet

The rest are variants.

You could use:
dim SrcWb as workbook, DestWb as workbook
but I like separate lines. I think it makes it easier to modify (for testing
and for updates!).

Second, you should add:
Option Explicit
to the top of your module.

This tells excel that you want to be forced into declaring your variables.

Then you won't have errors caused by lines like:

DestCell.Offset(0, 3) = SourceSHa.Cells(r, c)

SourceSha should be srcsha (or srcshb???).



I wasn't sure what should happen where, so you'll want to test this extensively!

I was confused by SrcShA and SrcShB. I changed the code to all SrcShA -- I'm
not sure if that's correct.

Option Explicit
Sub ReorgData()

Dim SrcWBa As Workbook
Dim SrcSha As Worksheet
'Dim SrcShb As Worksheet

Dim DestWB As Workbook
Dim DestSh As Worksheet

Dim DestCell As Range
Dim LastCol As Long
Dim LastRow As Long
Dim DestLastRow As Long
Dim c As Long
Dim r As Long

Dim SrcPath As String
Dim 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
With SrcSha
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

With DestSh
DestLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set DestCell = .Range("A" & DestLastRow)
Set DestCell = DestCell.Offset(1, 0)
End With

For c = 2 To LastCol
For r = 2 To LastRow
' Write DestWB Sheet1
If SrcSha.Cells(r, 1).Value <> "Total" Then 'Excludes Total Row
If SrcSha.Cells(r, c) <> "" Then
'dates are better handled using .value2
DestCell.value = SrcSha.Cells(1, c).Value2 'A = Date
DestCell.Offset(0, 1).value _
= SrcSha.Cells(1, 1).value 'B=Project
DestCell.Offset(0, 2).value _
= SrcSha.Cells(r, 1).value 'C=Activity
' From "Force" sheet
DestCell.Offset(0, 3).value _
= SrcSha.Cells(r, c).value 'D = Force
' From "Hours" sheet
DestCell.Offset(0, 4).value _
= SrcSha.Cells(r, c).value 'E =Hours
Set DestCell = DestCell.Offset(1, 0)
End If
Else
Exit For 'leave the inside loop
End If
Next r
Next c

With DestSh
.Range("A2").CurrentRegion.Sort _
Key1:=.Range("B2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
.Range("A:A").Selection.NumberFormat = "m/d/yyyy"
End With

Application.ScreenUpdating = True
SrcWBa.Close SaveChanges:=False
DestWB.Close SaveChanges:=True

Exit Sub

ErrorCatch:
MsgBox Err.Description ' "The sort reference is not valid..........."
Exit Sub

Application.ScreenUpdating = True

End Sub