Problem With VBA Sort Code...

B

ByerRA

New Member
Joined
Sep 18, 2009
Messages
22
I've been beating my head agianst the wall for two hours on this...

I can not get the following little piece of code to run properly, I keep getting a "Application-defined or object-defined error" when it adds the first sort key.

I've even recorded the macro directory from Excel and still get the error, I've recorded the sort in Office 2003 and still get the same error. I defined the sort range before the sort, I've tried just about everthing I could find though Google..

No matter what I do, I can't get this to work. :confused:

Any and all help would be appreciated as it's driving me nuts!!!

Code: 
Public Sub Test_Format(File_Name As String)
 
Dim xls As Excel.Application
Dim Compare_Workbook As Excel.Workbook
Dim Number_Rows As Long
 
    On Error GoTo Format_ERROR
    Set xls = GetObject(, Excel.Application)
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
    Set Compare_Workbook = xls.Workbooks.Open(File_Name)
    Do Until Compare_Workbook.Sheets.Count = 4
        Compare_Workbook.Sheets(1).Copy _
            After:=Compare_Workbook.Sheets(1)
    Loop
 
    Number_Rows = CLng(Compare_Workbook.Worksheets(Sheet_Count).UsedRange.Rows.Count)
    Compare_Workbook.Worksheets(Sheet_Count).Sort.SortFields.Clear
    Compare_Workbook.Worksheets(Sheet_Count).Sort.SortFields. _
          Add Key:=Range("$L$2:$L$" & CStr(Number_Rows)), _
          SortOn:=xlSortOnValues, Order:=xlAscending, _
          DataOption:=xlSortNormal
    Compare_Workbook.Worksheets(Sheet_Count).Sort.SortFields. _
          Add Key:=Range("$Y$2:$Y$" & CStr(Number_Rows)), _
          SortOn:=xlSortOnValues, Order:=xlDescending, _
          DataOption:=xlSortNormal
    With Compare_Workbook.Worksheets(Sheet_Count).Sort
         .SetRange Range("$A$1:$AJ$" & CStr(Number_Rows))
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
    Compare_Workbook.Close SaveChanges:=True
    xls.Application.Quit
    If Not Compare_Workbook Is Nothing Then
        Set Compare_Workbook = Nothing
    End If
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
    Exit Sub
 
 
Format_ERROR:
    If Err = 429 Then
        Err.Clear
        Set xls = CreateObject("Excel.Application")
        Resume Next
    End If
    If Not Compare_Workbook Is Nothing Then
        Compare_Workbook.Close SaveChanges:=False
        Set Compare_Workbook = Nothing
    End If
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
    xls.Application.Quit
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
    Exit Sub
 
End Sub
 
Last edited:

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
I had the same issue, my code worked fin in a test worksheet, but when i copied it over to one the up and running it gave me the same error. It was killing me, then someone ask me if i had a sub routine by the same name as where i was getting my error, and that was it. Basically i had a sub routine named format, and when my code ran it would hang up every time it hit the format code. Hope this helps
 
Upvote 0
Tridiro said:
I had the same issue, my code worked fin in a test worksheet, but when i copied it over to one the up and running it gave me the same error. It was killing me, then someone ask me if i had a sub routine by the same name as where i was getting my error, and that was it. Basically i had a sub routine named format, and when my code ran it would hang up every time it hit the format code. Hope this helps
Click to expand...

I wish it was that easy, but this is not the case as currently this is the only routine in the workbook at this time so it's not conflicting with another function.
 
Upvote 0
None of the ranges you are trying to use as keys have worksheet references.

Try this untested code.
Code: 
Public Sub Test_Format(File_Name As String)
Dim xls As Excel.Application
Dim Compare_Workbook As Excel.Workbook
Dim Number_Rows As Long
 
    On Error GoTo Format_ERROR
 
    Set xls = GetObject(, Excel.Application)
 
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
 
    Set Compare_Workbook = xls.Workbooks.Open(File_Name)
 
    Do Until Compare_Workbook.Sheets.Count = 4
        Compare_Workbook.Sheets(1).Copy After:=Compare_Workbook.Sheets(1)
    Loop
 
    With Compare_Workbook.Worksheets(Sheet_Count)
 
        Number_Rows = .UsedRange.Rows.Count
 
        .Sort.SortFields.Clear

        .Sort.SortFields. _
                Add Key:=.Range("$L$2:$L$" & CStr(Number_Rows)), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal

        .Sort.SortFields. _
                Add Key:=.Range("$Y$2:$Y$" & CStr(Number_Rows)), _
                    SortOn:=xlSortOnValues, Order:=xlDescending, _
                    DataOption:=xlSortNormal

        With .Sort
            .SetRange .Range("$A$1:$AJ$" & CStr(Number_Rows))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
    End With
 
    Compare_Workbook.Close SaveChanges:=True
 
    xls.Quit
 
    If Not Compare_Workbook Is Nothing Then
        Set Compare_Workbook = Nothing
    End If
 
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
 
    Exit Sub

Format_ERROR:
 
    If Err = 429 Then
        Err.Clear
        Set xls = CreateObject("Excel.Application")
        Resume Next
    End If
 
    If Not Compare_Workbook Is Nothing Then
        Compare_Workbook.Close SaveChanges:=False
        Set Compare_Workbook = Nothing
    End If
 
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
 
    xls.Application.Quit
 
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
 
    Exit Sub
 
End Sub
 
Upvote 0
Thanks, but no luck, same error when attempting to set the key.


Norie said:
None of the ranges you are trying to use as keys have worksheet references.

Try this untested code.
Code: 
Public Sub Test_Format(File_Name As String)
Dim xls As Excel.Application
Dim Compare_Workbook As Excel.Workbook
Dim Number_Rows As Long
 
    On Error GoTo Format_ERROR
 
    Set xls = GetObject(, Excel.Application)
 
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
 
    Set Compare_Workbook = xls.Workbooks.Open(File_Name)
 
    Do Until Compare_Workbook.Sheets.Count = 4
        Compare_Workbook.Sheets(1).Copy After:=Compare_Workbook.Sheets(1)
    Loop
 
    With Compare_Workbook.Worksheets(Sheet_Count)
 
        Number_Rows = .UsedRange.Rows.Count
 
        .Sort.SortFields.Clear
 
        .Sort.SortFields. _
                Add Key:=.Range("$L$2:$L$" & CStr(Number_Rows)), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
 
        .Sort.SortFields. _
                Add Key:=.Range("$Y$2:$Y$" & CStr(Number_Rows)), _
                    SortOn:=xlSortOnValues, Order:=xlDescending, _
                    DataOption:=xlSortNormal
 
        With .Sort
            .SetRange .Range("$A$1:$AJ$" & CStr(Number_Rows))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
    End With
 
    Compare_Workbook.Close SaveChanges:=True
 
    xls.Quit
 
    If Not Compare_Workbook Is Nothing Then
        Set Compare_Workbook = Nothing
    End If
 
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
 
    Exit Sub
 
Format_ERROR:
 
    If Err = 429 Then
        Err.Clear
        Set xls = CreateObject("Excel.Application")
        Resume Next
    End If
 
    If Not Compare_Workbook Is Nothing Then
        Compare_Workbook.Close SaveChanges:=False
        Set Compare_Workbook = Nothing
    End If
 
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
 
    xls.Application.Quit
 
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
 
    Exit Sub
 
End Sub
Click to expand...
 
Upvote 0
The variable, "Sheet_Count" is not given any value as far as I can tell in the code.

However the code should fall over the first time the empty variable is used...:confused:

Also, it would help the debug if you disabled the "on error" statement while testing.
 
Upvote 0
Isn't it usually Key1 not just Key?
 
Upvote 0
snowblizz said:
The variable, "Sheet_Count" is not given any value as far as I can tell in the code.

However the code should fall over the first time the empty variable is used...:confused:

Also, it would help the debug if you disabled the "on error" statement while testing.
Click to expand...

Whoops, "Sheet_Count" is set, when I was pasting code (removing comments) it got left out, the code should be...

Code: 
Public Sub Test_Format(File_Name As String)
 
Dim xls As Excel.Application
Dim Compare_Workbook As Excel.Workbook
Dim Number_Rows As Long
 
    On Error GoTo Format_ERROR
    Set xls = GetObject(, Excel.Application)
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
    Set Compare_Workbook = xls.Workbooks.Open(File_Name)
    Do Until Compare_Workbook.Sheets.Count = 4
        Compare_Workbook.Sheets(1).Copy _
            After:=Compare_Workbook.Sheets(1)
    Loop

    '
    ' Set "Sheet_Count to "1" for now, we will setup a loop later to
    ' loop through the 4 worksheets we just created with the copy.
    '
    Sheet_Count = 1
    Number_Rows = CLng(Compare_Workbook.Worksheets(Sheet_Count).UsedRange.Rows.Count)
    Compare_Workbook.Worksheets(Sheet_Count).Sort.SortFields.Clear
    Compare_Workbook.Worksheets(Sheet_Count).Sort.SortFields. _
          Add Key:=Range("$L$2:$L$" & CStr(Number_Rows)), _
          SortOn:=xlSortOnValues, Order:=xlAscending, _
          DataOption:=xlSortNormal
    Compare_Workbook.Worksheets(Sheet_Count).Sort.SortFields. _
          Add Key:=Range("$Y$2:$Y$" & CStr(Number_Rows)), _
          SortOn:=xlSortOnValues, Order:=xlDescending, _
          DataOption:=xlSortNormal
    With Compare_Workbook.Worksheets(Sheet_Count).Sort
         .SetRange Range("$A$1:$AJ$" & CStr(Number_Rows))
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
    Compare_Workbook.Close SaveChanges:=True
    xls.Application.Quit
    If Not Compare_Workbook Is Nothing Then
        Set Compare_Workbook = Nothing
    End If
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
    Exit Sub
 
 
Format_ERROR:
    If Err = 429 Then
        Err.Clear
        Set xls = CreateObject("Excel.Application")
        Resume Next
    End If
    If Not Compare_Workbook Is Nothing Then
        Compare_Workbook.Close SaveChanges:=False
        Set Compare_Workbook = Nothing
    End If
    If xls.Application.DisplayAlerts Then
        xls.Application.DisplayAlerts = False
    End If
    xls.Application.Quit
    If Not xls Is Nothing Then
        Set xls = Nothing
    End If
    Exit Sub
 
End Sub

I have turned off my error handler and get the same thing (first thing I tried), hanging when it sets the key with the same error message.
 
Upvote 0
Norie said:
Isn't it usually Key1 not just Key?
Click to expand...

Well, that's what Excel 2007 recorded when I did the sort manually and I also thought it was strange. :confused:

I then tried a piece of sort code that I know worked with Excel 2003 (changing the range and the sort columns, and it works from within a macro in Excel 2007) and it still died with the same error when tried as VBA code. :(

(I've never had a problem with sorting until Excel 2007 :mad:)
 
Upvote 0
Are you sure that Number_Rows is getting the right value?

Also why do you have all the conversion functions like CLng and CStr?
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Error when sorting table - with exact same code that is working elsewhere
Replies
2
Views
72
TheRedCardinal
T
F
  • Question
Code is missing Something
Replies
2
Views
180
farr80
F
A
  • Solved
VBA - button to sort by date in ascending and descending order
Replies
6
Views
352
Peter_SSs
Peter_SSs
melodramatic
  • Question
VBA - Sort Table in Alternate Workbook
Replies
1
Views
199
melodramatic
melodramatic
JenniferMurphy
  • Solved
Best code to sort a table column in a VBA macro
2 3
Replies
20
Views
1K
JenniferMurphy
JenniferMurphy

Forum statistics

Threads
1,214,651
Messages
6,120,739
Members
448,989
Latest member
mariah3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top