Method 'Range' of object '_global' failed during sort

[Socko]

I'm trying to fix an sub routine in an VB module that basically reads in a MS database and writes it to an Excel Spread sheet. It works just fine except that the data isn't sorted correctly. I have no experience at all in excel or the vb code to access excel. I found a few lines of code by searching on how to sort in vb for excel and the code with the new sort logic works fine the first time you run it, but run it twice and you get the titled error. Here is the code they created and I marked the code I added. Any help would be deeply appreciated. Sorry ahead of time for length of code.

Public Sub excel()
 
  Dim indx As Integer
  Dim rowIndex As Integer
  Dim colIndex As Integer
  Dim recordCount As Integer
  Dim fieldCount As Integer
  Dim MSG As String
  Dim avRows As Variant
  Dim excelVersion As Integer
  Dim transType As String
  Dim system As String
  Dim sql As String
  Dim TcrRecs()
  Dim Oput As String
 
  system = lstLOB.Text
  transType = lstTransacType.Text
 
'CHECK FOR SEARCH TYPE
  openconn
 
  If lstLOB.SelCount = 0 And lstTransacType.SelCount = 0 Then
    MsgBox "Search Requires A System/Transaction Or Both!", vbExclamation, "Error"
    closeconn
    Exit Sub
  End If
 
  If lstTransacType.SelCount > 0 Then
    For a = 0 To lstTransacType.ListCount - 1
      If lstTransacType.Selected(a) Then
        If sql = "" Then
          sql = " AND (TransacType = '" & lstTransacType.List(a) & "'"
        Else
          sql = sql + " or TransacType = '" & lstTransacType.List(a) & "'"
        End If
      End If
    Next
 
    Call rs("SELECT a.Name, b.TransacType, b.TestCaseNum, c.PolicyNum, b.TestScenarioDescription, c.Impact, c.ExpectedResults FROM Areas a, TestCases b, TestCaseExecution c WHERE a.AreaID = b.AreaID AND b.TestCaseID = c.TestCaseID " & sql & ") ORDER BY a.NAME, b.TransacType, b.TestCaseNum ASC")
 
  End If
 
  If lstLOB.SelCount > 0 And lstTransacType.SelCount = 0 Then
    For a = 0 To lstLOB.ListCount - 1
      If lstLOB.Selected(a) Then
        If sql = "" Then
          sql = " AND (name = '" & lstLOB.List(a) & "'"
        Else
          sql = sql + " or name = '" & lstLOB.List(a) & "'"
        End If
      End If
    Next
 
    Call rs("SELECT a.Name, b.TransacType, b.TestCaseNum, c.PolicyNum, b.TestScenarioDescription, c.Impact, c.ExpectedResults FROM Areas a, TestCases b, TestCaseExecution c WHERE a.AreaID = b.AreaID AND b.TestCaseID = c.TestCaseID " & sql & ") ORDER BY a.NAME, b.TransacType, b.TestCaseNum ASC")
 
  End If
 
  If adoRS.recordCount = 0 Then
    MsgBox "There Were No Test Cases Found Matching Your Criteria", vbInformation, "Error"
    closeconn
    Exit Sub
  End If
 
'THROWS THE RECORDSET INTO AN ARRAY
  avRows = adoRS.GetRows()
 
  recordCount = UBound(avRows, 2) + 1
  fieldCount = UBound(avRows, 1) + 1
 
'CREATE REDERENCE VARIABLE FOR THE SPREADSHEET
  Set objExcel = CreateObject("Excel.Application")
  objExcel.Visible = True
  objExcel.Workbooks.add
 
  Set objTemp = objExcel
 
  excelVersion = Val(objExcel.Application.Version)
  If (excelVersion >= 8) Then
    Set objExcel = objExcel.ActiveSheet
  End If
 
'PLACE THE NAMES OF THE FIELDS AS COLUMN HEADERS
 
  With objExcel.Cells(1, 1)
    .Value = "System"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 2)
    .Value = "Trans Type"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 3)
    .Value = "TC Nbr"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 4)
    .Value = "In Prog"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 5)
    .Value = "Req Nbr"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 6)
    .Value = "Policy Nbr"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 7)
    .Value = "Date"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 8)
    .Value = "Tstr Intls"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 9)
    .Value = "Test Scenario Description"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 10)
    .Value = "Impact"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
  With objExcel.Cells(1, 11)
    .Value = "Expected Results"
    .VerticalAlignment = xlVAlignTop
    With .Font
      .Name = "Arial"
      .Bold = True
      .Size = 11
      .Italic = True
    End With
  End With
 
'MEMORY MANAGEMENT
  adoRS.Close
  Set adoRS = Nothing
 
'ADD THE DATA
  With objExcel
    For rowIndex = 2 To recordCount + 1
 
      Oput = IIf(IsNull(avRows(1 - 1, rowIndex - 2)), "", avRows(1 - 1, rowIndex - 2))
      'Oput = avRows(1 - 1, rowIndex - 2)
      Oput = Replace(Oput, Chr(13), "")
      Oput = Replace(Oput, Chr(9), "")
      .Cells(rowIndex, 1).Value = Oput
 
'      .Cells(rowIndex, 1).Value = avRows _
'      (1 - 1, rowIndex - 2)
      Oput = IIf(IsNull(avRows(2 - 1, rowIndex - 2)), "", avRows(2 - 1, rowIndex - 2))
      'Oput = avRows(2 - 1, rowIndex - 2)
      Oput = Replace(Oput, Chr(13), "")
      Oput = Replace(Oput, Chr(9), "")
      .Cells(rowIndex, 2).Value = Oput
 
'      .Cells(rowIndex, 2).Value = avRows _
'     (2 - 1, rowIndex - 2)
      Oput = IIf(IsNull(avRows(3 - 1, rowIndex - 2)), "", avRows(3 - 1, rowIndex - 2))
      'Oput = avRows(3 - 1, rowIndex - 2)
      Oput = Replace(Oput, Chr(13), "")
      Oput = Replace(Oput, Chr(9), "")
      .Cells(rowIndex, 3).Value = Oput
 
'      .Cells(rowIndex, 3).Value = avRows _
'      (3 - 1, rowIndex - 2)
 
      .Cells(rowIndex, 4).Value = " "
      .Cells(rowIndex, 5).Value = " "
 
      Oput = IIf(IsNull(avRows(4 - 1, rowIndex - 2)), "", avRows(4 - 1, rowIndex - 2))
      'Oput = avRows(4 - 1, rowIndex - 2)
      Oput = Replace(Oput, Chr(13), "")
      Oput = Replace(Oput, Chr(9), "")
      .Cells(rowIndex, 6).Value = Oput
 
 '    .Cells(rowIndex, 6).Value = avRows _
 '    (4 - 1, rowIndex - 2)
 
      .Cells(rowIndex, 7).Value = " "
      .Cells(rowIndex, 8).Value = " "
 
      Oput = IIf(IsNull(avRows(5 - 1, rowIndex - 2)), "", avRows(5 - 1, rowIndex - 2))
      'Oput = avRows(5 - 1, rowIndex - 2)
      Oput = Replace(Oput, Chr(13), "")
      Oput = Replace(Oput, Chr(9), "")
      .Cells(rowIndex, 9).Value = Oput
 
  '    .Cells(rowIndex, 9).Value = avRows _
  '    (5 - 1, rowIndex - 2)
 
      Oput = IIf(IsNull(avRows(6 - 1, rowIndex - 2)), "", avRows(6 - 1, rowIndex - 2))
      'Oput = avRows(6 - 1, rowIndex - 2)
      Oput = Replace(Oput, Chr(13), "")
      Oput = Replace(Oput, Chr(9), "")
      .Cells(rowIndex, 10).Value = Oput
 
     ' .Cells(rowIndex, 10).Value = avRows _
     ' (6 - 1, rowIndex - 2)
      Oput = avRows(7 - 1, rowIndex - 2)
      Oput = Replace(Oput, Chr(13), "")
      Oput = Replace(Oput, Chr(9), "")
     .Cells(rowIndex, 11).Value = Oput
'      .Cells(rowIndex, 11).Value = avRows _
'      (7 - 1, rowIndex - 2)
 
    Next
  End With
 
  objExcel.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
  objExcel.Cells(1, 1).CurrentRegion.VerticalAlignment = xlVAlignTop
  objExcel.Cells(1, 1).CurrentRegion.WrapText = True
 
' This what I added*******************************************************
  Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _
   , Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:= _
  xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'*************************************************************************
 
  closeconn
 
End Sub
 
 

[MikeTheBike]

Hi

Without ploughing through all your code, and based on my the interpritation that it ALWAYS works without the sort, and works just ONCE with the the sort code, I suggest this mod

Change this

' This what I added*********************************************  **********
  Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _
   , Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:= _
  xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'*************************************************  ************************

to this

' This what I added*********************************************  **********
  objExcel.Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _
   , Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:= _
  xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'*************************************************  ************************

This suggestion is based on very similar problem I had exporting a report to Word (which IMHO is much worse to automate that Excel, as the native object are not so obvious!).

The above suggestion is based on a similar once pass only is OK problem, the explanation being that the native Word/Excel object that are not excplicitly refered to the Woed/Excel object stay referenced to the first instance of Word/Excel, which changes to a different instance for the second pass. Therefore you need to referance the active Word/Excel object that is current instance !!!???

Be interested to see if it solves your problem.


MTB