2003 to 2007 compatibilty issue

A

aadenning

New Member
Joined
Jul 2, 2012
Messages
7
Hi,

I run a macro everyday and have been using 2003 until just recently. Our office has switched over to 2007 and now the macro is erroring out. I have tried a few things but nothing seems to work.

I'm receiving a "Run-time-error' -2147417848 (80010108)' Method 'Sort' of object 'Range' failed", and then the workbook locks up and I have to force quit.

Here's the code that debugger highlights:

Code: 
         Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Sort _
         Key1:=Range("B50"), Order1:=xlAscending
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Welcome to the Board!

I would recommend starting with your variables.
Are the named ranges "TableStart" and "TableLastCol" defined? What are their values?
Likewise, what is the value of "jobcount"?
 
Upvote 0
I don't believe "TableStart" and "TableLastCol" are defined (Sorry about my ignorance, I inherited this code from someone a little more advanced in VBA than I am).

Below is the full code:

Code: 
Dim filex As String
Public NumofTravPositions As Integer
Public NumofFlowDays As Integer
Public FlowDay As Integer
Public TravelersByPos(1 To 6, 1 To 4, 1 To 30) As Integer   'An array which holds CCs that are traveling at each position after leaving the originating shop
Public LNPosition(1 To 6) As Integer    'This array holds ACTUAL line numbers at each position based on the current schedule
Public jobcount As Integer
Public noUpdate As Boolean
Public AddLNContinue As Boolean

Sub InitializeProgram()
'This will make sure the program is initialized correctly
        Worksheets("Travelers").Visible = True
        
Range("JobData").ClearContents      'Clear traveling jobs list on the first sheet
    
End Sub
Sub Rectangle_click()
frmUpdate.Show
End Sub

Sub ImportData()
Application.ScreenUpdating = False
    'Count Jobs (Erase two to account for text in column)
    Sheets("TMC Report").Select
    jobcount = Application.CountA(Range(Range("TableStart"), Range("TableStart").Offset(1000, 0))) - 3
    
    'Convert Text to Numbers - This is used to account for times when TMC data gets imported as text (precaution)
    Range(Range("TableStart"), Range("TableStart").Offset(jobcount - 1, 2)).Value = Range(Range("TableStart"), Range("TableStart").Offset(jobcount - 1, 2)).Value
        
    'Sort Data by Line followed by CC
   ' Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Select
     
   ' Selection.Sort Key1:=Range("B44"), Order1:=xlAscending, Key2:=Range("C44" _
        ), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        
       'Sort Data by Line followed by CC
        'E1=Position  D1=CC B1=LN C1=Shop I1=Desc
        
        'SORT BY DESCRIPTION
        Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Sort _
        Key1:=Range("D50"), Order1:=xlAscending _
        , Key2:=Range("E50"), Order2:=xlDescending
        
        'CUSTOM SORT OF CC BY SHOP WORK ORDER (WINGS,HORIZ STAB,VERT FIN,OVERWING FRG,AFT,TEFLON,STUB,GEAR,FWD,AFT,MID)
        Application.AddCustomList ListArray:=Array( _
        "805", "730", _
        "780", "512", "520", _
        "742", "543", _
        "334", "785", "798", _
        "314", _
        "818", _
        "338", _
        "138", _
        "315", "316", "823", "741", _
        "820", "746", _
        "826", "744", _
        "128", "840", "131", "121")
        
        customListNum = Application.GetCustomListNum(Array("805", "730", "780", "512", "520", "742", "543", _
        "334", "785", "798", "314", "818", "338", "138", "315", "316", "823", "741", "820", "746", "826", "744", _
        "128", "840", "131", "121"))
         Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Sort Key1:=Range("C50"), Order1:=xlAscending, Header:=xlGuess, _
             OrderCustom:=customListNum + 1, MatchCase:=False, Orientation:=xlTopToBottom, _
             DataOption1:=xlSortNormal
        
         Application.DeleteCustomList customListNum
        'END OF CUSTOM SORT
        
        'SORT BY LN
         Range(Range("TableStart"), Range("TableLastCol").Offset(jobcount - 1, 0)).Sort _
         Key1:=Range("B50"), Order1:=xlAscending
        
        'ALGORITHM TO MOVE NCRS BEFORE RELATED IP
                'This goes through the TMC report and finds the IP related to each NCR, then moves
                'the NCR under its respective IP (if no related IP, it will not be moved)
                
        'Search for NCRs in Working Traveler Report
        
            'Variables
            Dim RelatedIP As String, WorkingCurrentIP As String, WorkingNCR As String 'These are used for NCR comparisons
            
            h = 0
            Do While Range("TableStart").Offset(h, 0) <> ""
                Range("TableStart").Offset(h, 0).EntireRow.Name = "NCRRange"
                WorkingNCR = Range("TableStart").Offset(h, 4)
                
                    Range("TableStart").Offset(h, 4).Select
                    
                    
                'Check if is a NCR and Search for "Related IP" in TMC Report
                If Mid(WorkingNCR, 9, 1) = "N" Then
                
                    RelatedIP = Range("TableStart").Offset(h, 6)
                
                     z = 0
                     Do While Range("TableStart").Offset(z, 0) <> ""
                         WorkingCurrentIP = Range("TableStart").Offset(z, 4)
                         
                             'Cut Cells When Find "Related IP" is the same and line numebers are the same
                             If CompareStrings(RelatedIP, WorkingCurrentIP) _
                                And Range("TableStart").Offset(h, 1) = Range("TableStart").Offset(z, 1) Then
                                             
                                'MsgBox TruncateWorkingCurrentIP
                                    If Range("NCRRange").Row <> Range("TableStart").Offset(z + 1, 0).Row Then
                                        Range("NCRRange").Cut
                                        Range("TableStart").Offset(z + 1, 0).EntireRow.Select
                                        Selection.Insert Shift:=xlDown
                                        
                                        'Adjust for added row
                                        If z >= h Then
                                            h = h - 1
                                        End If
                                        
                                    End If
                                   
                                'Exit if NCR Found
                                Exit Do
                            End If
            
                    z = z + 1
                    Loop
             End If
      
          h = h + 1
          Loop
          
'END SORT NCR ALGORITHM
    CreateNewReport
    
End Sub
Function CompareStrings(String1 As String, String2 As String) As Boolean
'Function returns true if strings are the same or false if not
Dim cString(1 To 2), TruncateString(1 To 2) As String
cString(1) = String1
cString(2) = String2
        'Truncate if necessary (to get rid of spaces at end of string - for fair comparison)
        For i = 1 To 2
            If cString(i) <> "" Then
                If Mid(cString(i), Len(cString(i)), 1) = " " Then
                    TruncateString(i) = Left(cString(i), Len(cString(i)) - 1)
                Else
                    TruncateString(i) = cString(i)
                End If
            End If
        Next i
         
         
         
            'Check If Strings Are the Same
                If UCase(TruncateString(1)) = UCase(TruncateString(2)) Then
                    CompareStrings = True
                Else
                    CompareStrings = False
                End If
        
End Function
 
Sub CreateNewReport()
Dim i, v As Integer
Dim cLineNumber As Integer  'Holds the current AP line number being "worked" on
Dim oldLineNumber As Integer    ''Holds the previous AP line number being "worked" on
Dim CurrentLine As Integer      'Holds the current excel row numbers as the sheets is populated
Dim LNJobCount As Integer       'Holds the count of jobs on the current LN
Dim cPosition As Integer        'Holds the position of the Line Number (=0 when plane in factory, but out of position and -1 if plane is
Dim Traveler As Integer         'Value of indicates job is traveler, 0 not traveler
Dim CurrentIP As String         'Holds the IP being copied
Dim WorkingCurrentIP As String  'Holds the IP being compared from the "workingtravelerreport"
Dim r As Integer
Dim CountTrigger As String      'Used to check for start condition of heading loop
Dim TMCNCR As String, WorkingNCR As String 'These are used for NCR comparisons
Dim planeposition As Integer    'Holds the row number for updating status on the "travelers" sheet
Dim Position As String          'Holds the string that describes plane position - for example "FA","FBJ", etc.
Application.ScreenUpdating = False
Range("LastFlowDay") = FlowDay
'Clear Old Data NOTE: 1000 is default row length- what if traveler report grows larger?
    Sheets("WorkingTravelerReport").Select
    Rows("1:1000").Select
    Selection.Delete Shift:=xlUp
    
 
Sheets("TMC Report").Select
'Start Values
oldLineNumber = 0
CurrentLine = 0
LNJobCount = 0
      
'Loop to go through lines
For i = 0 To jobcount - 1
cLineNumber = Range("TableStart").Offset(i, 1).Value
    'Check if traveler routine and Check if RO or MH
        'Initial Values
        JobCC = 0
        LastCC = 818     'SET TO BE FIRST CONTROL CODE TO TRAVEL IF CC NOT FOUND IN CCTABLE
        Traveler = -1
                
        'Check if RO or MH
        Sheets("TMC Report").Select
        If Range("TableStart").Offset(i, 5) <> "RO" And Range("TableStart").Offset(i, 5) <> "MH" And Range("TableStart").Offset(i, 5) <> "CO" Then
        
            'Check if Traveler
            
            
            'FIND THE LAST CC
            '-----------------------------------------------------------------------------------
            
            'Write CC
            JobCC = Range("TableStart").Offset(i, 2)
            
            'Get Last CC
            t = 0
            u = 0
            Do
                t = t + 1
                
                Do
                    u = u + 1
                Loop While Sheets("CCTable").Range("A1").Offset(t, u) <> JobCC _
                        And Sheets("CCTable").Range("A1").Offset(t, u) <> ""
                    
                If Sheets("CCTable").Range("A1").Offset(t, u) = JobCC Then
                    LastCC = Sheets("CCTable").Range("A1").Offset(t, 0)
                    Exit Do
                End If
                
                u = 0
                
            Loop While Sheets("CCTable").Range("A1").Offset(t, 0) <> ""
            '-----------------------------------------------------------------------------------
            
            'FIND IF TRAVELER OR NOT BASED ON DATE
            '-----------------------------------------------------------------------------------
            'Find Line Number in Table
            t = 1
            Do While Sheets("ScheduleTable").Range("C2").Offset(t, 0) <> "" _
                        And Sheets("ScheduleTable").Range("C2").Offset(t, 0) <> cLineNumber
                t = t + 1
            Loop
            
            'Find correct CC in Table
            u = 1
            Do While Sheets("ScheduleTable").Range("C2").Offset(0, u) <> "" _
                        And Sheets("ScheduleTable").Range("C2").Offset(0, u) <> LastCC
                u = u + 1
            Loop
            
            'Traveler or Not
            If Date > Sheets("ScheduleTable").Range("C2").Offset(t, u) _
                    And Sheets("ScheduleTable").Range("C2").Offset(0, u) <> "" Then
                Traveler = 1
            End If
            '-----------------------------------------------------------------------------------
  
               'Add Job to List (If traveler)
                If Traveler = 1 Then
                            
                         'Headings
                        If cLineNumber <> oldLineNumber Then
                            Sheets("WorkingTravelerReport").Select
                            
                                If oldLineNumber = 0 Then
                                    CurrentLine = CurrentLine + 2
                                Else
                                    AddHeadings CurrentLine, LNJobCount, oldLineNumber
                                    CurrentLine = CurrentLine + 5
                                End If
                            
                            Sheets("WorkingTravelerReport").Select
                            Range("C1").Offset(CurrentLine - 1, 0).Value = cLineNumber
                            oldLineNumber = cLineNumber
                            LNJobCount = 0
                            
                            Sheets("WorkingTravelerReport").Select
                            Range(Range("A1").Offset(CurrentLine - 2, 0), Range("K1").Offset(CurrentLine - 2, 0)).Interior.ColorIndex = 15
                        End If
                                                                            
                
                        Sheets("TMC Report").Select
                        LNJobCount = LNJobCount + 1
                        Range(Range("TableStart").Offset(i, 2), Range("TableStart").Offset(i, 4)).Select
                        Selection.Copy
                        Sheets("WorkingTravelerReport").Select
                        Range("D1").Offset(CurrentLine, 0).Select
                        ActiveSheet.Paste
                        
                        Sheets("TMC Report").Select
                        Range("TableStart").Offset(i, 7).Select
                        Selection.Copy
                        Sheets("WorkingTravelerReport").Select
                        Range("G1").Offset(CurrentLine, 0).Select
                        ActiveSheet.Paste
                        
                        'Add Shift To Report
                        Sheets("TMC Report").Select
                        Range("TableStart").Offset(i, 9).Select
                        Selection.Copy
                        Sheets("WorkingTravelerReport").Select
                        Range("C1").Offset(CurrentLine, 0).Select
                        ActiveSheet.Paste
                        Selection.Value = Selection.Value
                        
                        'Add Crew Bar Line To Report
                        Sheets("TMC Report").Select
                        Range("TableStart").Offset(i, 10).Select
                        Selection.Copy
                        Sheets("WorkingTravelerReport").Select
                        Range("B1").Offset(CurrentLine, 0).Select
                        ActiveSheet.Paste
                        Selection.Value = Selection.Value
                        
                        CurrentIP = Range("F1").Offset(CurrentLine, 0).Value
                        'Check for and copy previous report comments
                           Sheets("Travelers").Select
                           For q = 1 To 1000
                            r = 1
                                If Range("LineNumber").Offset(q, 0) = cLineNumber Then
                                    Do While Len(Range("JOB").Offset(q + r).Text) >= 10   'CHANGED TO TRY TO FIX DELETING ERROR
                                            WorkingCurrentIP = Range("JOB").Offset(q + r).Value
                                                
                                            If CompareStrings(WorkingCurrentIP, CurrentIP) Then
                                                 Range(Range("ECD").Offset(q + r), Range("Comments").Offset(q + r)).Copy
                                                Sheets("WorkingTravelerReport").Select
                                                Range("H1").Offset(CurrentLine, 0).Select
                                                ActiveSheet.Paste
                                            End If
                                        r = r + 1
                                    Loop
                                End If
                            Next q
                            
                                'NEW CODE TO INSERT "RFI" WHEN SHOWN IN TMC
                                If UCase(Left(Sheets("WorkingTravelerReport").Range("I1").Offset(CurrentLine, 0).Text, 3)) = "RFI" Then
                                   If Left(Range("TableStart").Offset(i, 13).Text, 3) <> "RFI" Then
                                        Sheets("WorkingTravelerReport").Range("I1").Offset(CurrentLine, 0) = ""
                                    End If
                                Else
                                    If Left(Range("TableStart").Offset(i, 13).Text, 3) = "RFI" Then
                                        Sheets("WorkingTravelerReport").Range("I1").Offset(CurrentLine, 0) = "RFI"
                                    End If
                                End If
                                
                                'NEW CODE TO ADD COMMENTS TO JOB WHEN THEY ARE IN TMC
                                If Range("TableStart").Offset(i, 16) <> "" Then
                                    'Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).ClearComments
                                    Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).AddComment
                                    Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).Comment.Text Text:=Range("TableStart").Offset(i, 16).Text
                                Else
                                    Sheets("WorkingTravelerReport").Range("F1").Offset(CurrentLine, 0).ClearComments
                                End If
        
                    'Make sure lines don't "overflow"
                     Sheets("WorkingTravelerReport").Select
                    If Range("H1").Offset(CurrentLine, 0) = "" Then
                         Range("H1").Offset(CurrentLine, 0) = " "
                    End If
                                                            
                    'Advance to next line
                        Sheets("WorkingTravelerReport").Select
                        CurrentLine = CurrentLine + 1
                            
                            
                End If
                      
        End If
        
Next i
AddHeadings CurrentLine, LNJobCount, oldLineNumber

'FORMATTING
Sheets("WorkingTravelerReport").Select
     With Range(Range("A1"), Range("K1").Offset(CurrentLine + 1, 0))
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    
    
'Transfer new report over old report
Sheets("Travelers").Select
'Delete Assumes Less Than 1000 Jobs Long
Rows("25:1025").Delete Shift:=xlUp
Sheets("WorkingTravelerReport").Select
Rows("1:1001").Copy
Sheets("Travelers").Select
Range("A25").EntireRow.Insert Shift:=xlDown
'Update Airplane Display
    If noUpdate = False Then
        Range("BehindSchedule").QueryTable.Refresh BackgroundQuery:=False
        Range("yStatus").Value = Range("tStatus").Value
        Range("tStatus").Value = Range("BehindSchedule").Offset(Application.Count(Range(Range("BehindSchedule"), Range("BehindSchedule").Offset(1000, 0))), 0).Value
     End If
    
'Set Print Area
ActiveSheet.PageSetup.PrintArea = ""
    
Range("A1").Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I don't believe "TableStart" and "TableLastCol" are defined
Click to expand...
Your code uses them. They look like named ranges. If there are no named ranges on your worksheet, the code will not work.
Go into your Worksheet and take a look at the named ranges and see if these two named ranges exist.
If they do not, there is your problem!
 
Upvote 0
Very strange. I looked for both but could not find them. I then ran it on 2003 on a different PC at work and it ran with no problems. Do I need to declare the ranges some different way. I'm lost on this one.
 
Upvote 0
Trying adding this code to a module and running:

Code: 
Sub MyRangeTest()
   MsgBox Range("TableStart").Address
   MsgBox Range("TableLastCol").Address
End Sub

It should return the addresses if each. At least then you will know if it is identifying those ranges correctly.
 
Upvote 0
Note that you also have this line of code dependent upon those two variables:
Code: 
jobcount = Application.CountA(Range(Range("TableStart"), Range("TableStart").Offset(1000, 0))) - 3
You may want to see what "jobcount" returns.

Does it allow you to step through your code line-by-line using the F8 key?
If so, you can do that, and check the values along the (by hovering over the variables after it processes that line of code). That may give you some idea of what is going on.
 
Upvote 0
Try opening the same file on your computer with Access 2003 and step through the same code.
Does it say that jocount=0 there also?
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
VBL loop help
Replies
3
Views
102
mse330
M
L
  • Solved
VBA code checks a condition, stops macro if FALSE, etc.
Replies
3
Views
127
Peter_SSs
Peter_SSs
R
  • Question
Advanced Filter Macro works until I run a different Advanced Filter Macro in same workbook
Replies
1
Views
81
rdarrylhudson
R
A
  • Solved
Macro doesn't run in full from button control?
Replies
7
Views
290
NdNoviceHlp
NdNoviceHlp
H
  • Question
Macro Custom Sort
Replies
4
Views
445
howard
H

Forum statistics

Threads
1,214,646
Messages
6,120,715
Members
448,985
Latest member
chocbudda

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