Access and Excel

[Kenln]

I am having problems sorting an excel spreadsheet.

The following code works once. Just once then I get an error.

It is a message box that says:
Title = Miscrosoft Office Access
Message = "Method 'Range' of object'_Global' failed"

xlWorkSheet.Range(xlWorkSheet.Cells(1, 1), xlWorkSheet.Cells(iRowEnd, iColEnd)).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range _
("B2"), Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal

At the end of the code I run:

    Set xlRange = Nothing
    Set xlWorkSheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing

I'm sure it is something still open because if I close the Access db and reopen it, it will work fine (once).

Any help would be appreciated,

Thank you

 

[Kenln]

Does anyone have any thoughts on this. I am kinda stuck.

A possibe solution is to trigger code in Excel to do the sort. This is less preferable as I lose a bit of control. But if that is the only way to get it to work then okay.

I have searched the forums and cannot get the code to execute. It keeps saying it is not found. I would prefer to run the code in access if at all possible.

 

[namliam]

First lets make it more readable

xlWorkSheet.Range(xlWorkSheet.Cells(1, 1), xlWorkSheet.Cells(iRowEnd, iColEnd)).Sort _
    Key1:=Range("A2"), Order1:=xlAscending, _
    Key2:=Range("B2"), Order2:=xlAscending, _
    Key3:=Range("C2"), Order3:=xlAscending, _
    Header:=xlGuess, _ 
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:= xlTopToBottom, _
    DataOption1:=xlSortNormal, _
    DataOption2:=xlSortNormal, _
    DataOption3:=xlSortNormal

Try replacing all the XLVariables by real values...

The XL variables are not (always) available in Access and may cause this error. You can find the values by going into excel VBA debug window typing ?XLVariable<enter>

Using XLGuess in code is a BIG no-no, use either yes or no, dont let excel do stuff for you if you are coding.

Are you setting and closing everything properly?
I.e.
xlApp.quit
Set xlApp = createobject...

 

[Kenln]

Okay I made it more readable. Oops I should have done that first.

Also I changed xlGuess to xlYes. I am not using xlApp.quit because I close it manually. The user will do the same. I do check of the form is already open so I don't open it twice.

I use Set xlApp = CreateObject("Excel.Application").

 

[namliam]

I do then presume you also do xlApp.visible = True ??

Dont use the XL variables... xlYes is better replaced by 1

What is your full (applicable) code?

 

[Kenln]

Full code???

It is lenghty. It is canned code that I created a while ago to be reusable so there are if then's and commented out parts.

'Sub Display_Excel(Excel_Archive As String)
On Error GoTo Err_sExcel_SubRoutine

'Dim Active_Printer
    'Active_Printer = B_Size_Printer

'****************************************
'Define File Names and Path
Dim strMyPath As String
    strMyPath = Application.CurrentProject.Path
Dim strMyFile As String
    strMyFile = "Job Info - Report.xls"
Dim strSaved_fName As String
    strSaved_fName = strMyFile
'    strSaved_fName = DLookup("[Job_No]", "tbl_Job_Desc")
'    strSaved_fName = strSaved_fName & " - My Report - "

'    strSaved_fName = strSaved_fName & Year(Now())
'
'    If Val(Month(Now())) < 10 Then
'        strSaved_fName = strSaved_fName & "0" & Month(Now())
'    Else
'        strSaved_fName = strSaved_fName & Month(Now())
'    End If
'
'    If Val(Day(Now())) < 10 Then
'        strSaved_fName = strSaved_fName & "0" & Day(Now())
'    Else
'        strSaved_fName = strSaved_fName & Day(Now())
'    End If
'
'    strSaved_fName = strSaved_fName & ".xls"

Dim strMyExcel As String
Dim strMyFile_Path ' As String
'****************************************

'****************************************
'Define file properties
Dim bExcel_Running As Boolean
    bExcel_Running = False
Dim bFile_Exist As Boolean
    bFile_Exist = False
Dim bFile_Open As Boolean
    bFile_Open = False
'****************************************

    '****************************************
    'Check to see if the files exist
    strMyExcel = Dir(strMy_App_Dir & "\" & strTemplate_File_2) ' Retrieve the first entry.
    If strMyExcel <> "" Then
        bFile_Exist = True
    Else
        MsgBox "The Required File" & vbCrLf & vbCrLf _
        & strTemplate_File_2 + vbCrLf + vbCrLf _
        & "for this project cannot be found!", vbCritical, "Excel Template"

        GoTo Exit_sExcel_SubRoutine
    End If
    '****************************************

'****************************************
'Define Excel
Dim xlApp As Object
'Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim xlRange As Excel.Range
'****************************************

    '****************************************
    'If the file exist Check to see if Excel if running
    If bFile_Exist = True Then
        ' Getobject function called without the first argument returns a
        ' reference to an instance of the application. If the application isn't
        ' running, an error occurs.
        On Error Resume Next
        Set xlApp = GetObject(, "Excel.Application")
        ' Check to see if Excel is running.
        If Err.Number <> 0 Then
            Err.Clear    ' Clear Err object in case error occurred.
            bFile_Open = False
        Else
        ' If Excel is running check if the required Workbook is already open
            bExcel_Running = True
            With xlApp.Application
                For Each xlWorkBook In .Workbooks
                    If xlWorkBook.Name = strMyFile Then
                        MsgBox "The Excel file" & vbCrLf & "for this project is already open", vbInformation, "Excel File"
                        bFile_Open = True
                    End If
                Next xlWorkBook
            End With
        End If
        On Error GoTo Err_sExcel_SubRoutine
        Set xlApp = Nothing
    End If
    '****************************************

    If bFile_Exist = False Or bFile_Open = True Then
        GoTo Exit_sExcel_SubRoutine
    End If

    If bFile_Open = False Then
        Dim fs, f
        strMyExcel = Dir(strMyPath & "\" & strMyFile) ' Retrieve the first entry.
        If strMyExcel <> "" Then
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFile(strMyPath & "\" + strMyFile)
            f.Attributes = 0
        End If

        FileCopy strMy_App_Dir & "\" & strTemplate_File_2, strMyPath & "\" + strMyFile
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.GetFile(strMyPath & "\" & strMyFile)
        f.Attributes = 1
    End If

    '****************************************
    'Open or create Excel workbook

    Set xlApp = CreateObject("Excel.Application")

    'Use to create new workbooks
    'Set xlWorkBook = xlApp.Workbooks.Add
    Set xlWorkBook = xlApp.Workbooks.Open(strMyPath + "\" + strMyFile)

    xlApp.Visible = True
    xlWorkBook.Windows(1).Visible = True
    '****************************************

'****************************************
'****************************************
' Begin First Data Block

    '****************************************
    'ADO
    'Dim Conn1 As ADODB.Connection
        'Set Conn1 = CurrentProject.Connection

    'DAO
    Dim DAODb As DAO.Database
        Set DAODb = CurrentDb
    '****************************************

    Dim strField_Name As String

    Dim iTab_Index As Integer
    Dim bSubTotal As Boolean
        bSubTotal = True

    Dim iColStart As Integer
        iColStart = 5
    Dim iColEnd As Integer
        iColEnd = 0
    Dim iRowStart As Integer
        iRowStart = 2
    Dim iRowEnd As Integer
        iRowEnd = 0
    Dim iCol As Integer
    Dim iRow As Integer
        iCol = 0
        iRow = 0

    Dim x1 As Integer
    Dim x2 As Integer

    Dim strMySQL As String
        strMySQL = ""
            strMySQL = "SELECT tblName.* "
            strMySQL = strMySQL & "FROM tblName"
            strMySQL = strMySQL & ";"

    '****************************************
    'Define Recordset
    'AOD
    'Dim MyRst As New ADODB.Recordset
        'MyRst.ActiveConnection = Conn1
        'Set MyRst = New ADODB.Recordset

        'MyRst.Open (strMySql + strMySql_Where + strMySql_Order), CurrentProject.Connection

    'DAO
    Dim MyRst As DAO.Recordset
        'Set MyRst = DAODb.OpenRecordset(strMySQL)
        'Set MyRst = DAODb.OpenRecordset("qryfrm_Job_Posting_Active_Combined")

    'To get recordset from a form
    'Note should check to see of form is open
    Dim Rs1 As DAO.Recordset
        Set Rs1 = sfrm_PMP.Form.Recordset
        Set MyRst = Rs1.Clone
    '****************************************

    '****************************************
    If MyRst.RecordCount <> 0 Then

        '****************************************
        'Excel Formating and data

        'Set xlWorkSheet = xlWorkBook.Worksheets(1)
        Set xlWorkSheet = xlWorkBook.Worksheets("By PE")
        xlWorkSheet.Visible = xlSheetVisible
        xlWorkSheet.Select
        xlWorkSheet.Activate

        'Set xlWorkSheet = xlWorkBook.Worksheets("M06124")
        'xlWorkSheet.Visible = xlSheetHidden

        'Set xlWorkSheet = xlWorkBook.Worksheets.Add
        'Set xlWorkSheet = xlWorkBook.Worksheets(1)

        'xlWorkSheet.Name = "Test"
        'xlApp.Sheets("Sheet1").Name = "Test"
        'xlApp.Worksheets("Test").Activate
        '****************************************

        '****************************************
        ' Load Data
        'Set xlRange = xlWorkSheet.Range("B2")
        'With xlRange
            '.CopyFromRecordset MyRst
        'End With

        'xlWorkSheet.Range("A9").CopyFromRecordset MyRst

        xlWorkSheet.Range(xlWorkSheet.Cells(iRowStart, 1), xlWorkSheet.Cells(iRowStart, 1)).CopyFromRecordset MyRst
        '****************************************

        ''Area Order
        'xlWorkSheet.Columns("M:M").Select
        'xlApp.Selection.Delete Shift:=xlToLeft
        ''Status
        'xlWorkSheet.Columns("L:L").Select
        'xlApp.Selection.Delete Shift:=xlToLeft
        ''Supervisor
        'xlWorkSheet.Columns("H:H").Select
        'xlApp.Selection.Delete Shift:=xlToLeft
        ''Estimator
        'xlWorkSheet.Columns("G:G").Select
        'xlApp.Selection.Delete Shift:=xlToLeft

        '****************************************
        'Count the number of rows and columns
        'While xlApp.Sheets(1).Cells(iRowEnd, 1) <> ""
            'iRowEnd = iRowEnd + 1
        'Wend
    
        iRowEnd = MyRst.RecordCount + iRowStart
        Dim iMyRst_Count_1 As Integer
            iMyRst_Count_1 = MyRst.RecordCount + iRowStart
        iColEnd = MyRst.Fields.Count
        '****************************************

        '****************************************
        ' Add Field Names as colum headers
        'For x = 0 To MyRst.Fields.Count - 1
            'xlWorkSheet.Cells(iRowStart - 1, x + 1).Value = MyRst.Fields(x).Name
        'Next
        'xlWorkSheet.Range(xlWorkSheet.Cells(iRowStart - 1, 1), xlWorkSheet.Cells(iRowStart - 1, MyRst.Fields.Count)).Font.Bold = True
        '****************************************
        MyRst.Close
        Set MyRst = Nothing
        'Set Rs1 = Nothing
        Set DAODb = Nothing
        '****************************************

        '****************************************
        'Change Sort Order
        xlApp.Range(xlWorkSheet.Cells(1, 1), xlWorkSheet.Cells(iRowEnd - 1, iColEnd)).Sort _
        Key1:=Range("A2"), Order1:=xlAscending, _
        Key2:=Range("B2"), Order2:=xlAscending, _
        Key3:=Range("C2"), Order3:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal, _
        DataOption3:=xlSortNormal
'        xlApp.Run "sSort_by_PE"

        '****************************************

        'Add Auto Filter
        'xlWorkSheet.Rows(iRowStart - 1).Select
        xlWorkSheet.Range(xlWorkSheet.Cells(iRowStart - 1, 1), xlWorkSheet.Cells(iRowEnd, iColEnd)).Select
        xlApp.Selection.AutoFilter

        'Set default format
        xlWorkSheet.Cells.Select
        'To set Style as Currency
        xlApp.Selection.Style = "Currency"
        'To Set Style as Number
        'Xl.Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

        '****************************************
        'Add grid lines in data area
        If iRowEnd - iRowStart > 1 Then
            Set xlRange = xlWorkSheet.Range(xlWorkSheet.Cells(iRowStart, 1), xlWorkSheet.Cells(iRowEnd - 1, iColEnd))
        Else
            Set xlRange = xlWorkSheet.Range(xlWorkSheet.Cells(iRowStart, 1), xlWorkSheet.Cells(iRowEnd, iColEnd))
        End If

        xlRange.Borders(xlDiagonalDown).LineStyle = xlNone
        xlRange.Borders(xlDiagonalUp).LineStyle = xlNone
        With xlRange.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        If iRowEnd - iRowStart > 1 Then
            With xlRange.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        End If
        '****************************************

        '****************************************
        'For Subtotals
        If bSubTotal = True Then
            xlWorkSheet.Range(xlWorkSheet.Cells(iRowStart - 1, 1), xlWorkSheet.Cells(iRowStart - 1, 1)).Select
            xlApp.Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
            iCol = 1

            xlApp.ActiveSheet.Outline.ShowLevels RowLevels:=2

            While xlApp.Sheets(1).Cells(iRowEnd, iCol) <> ""
                iRowEnd = iRowEnd + 1
            Wend

            iRowEnd = iRowEnd - 1
            iRow = iRowEnd - 1
        Else
        'else Add summary formula
            Set xlRange = xlWorkSheet.Range(xlWorkSheet.Cells(iRowEnd, iColStart), xlWorkSheet.Cells(iRowEnd, iColStart))

            For x1 = iColStart To iColEnd
                xlRange.Formula = "=Subtotal(9,R[-" + Trim(Str(iRowEnd - iRowStart)) + "]C:R[-1]C)"
                Set xlRange = xlRange.Offset(0, 1)
            Next x1

            iRow = iRowEnd
        End If
        '****************************************

        'Add grid lines to summary area
        Set xlRange = xlWorkSheet.Range(xlWorkSheet.Cells(iRow, iColStart), xlWorkSheet.Cells(iRowEnd, iColEnd))

        xlRange.Borders(xlDiagonalDown).LineStyle = xlNone
        xlRange.Borders(xlDiagonalUp).LineStyle = xlNone
        With xlRange.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        '****************************************
        'For Subtotals
        If bSubTotal = True Then
            With xlRange.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        End If
        '****************************************

        'Add double line above summary line
        Set xlRange = xlWorkSheet.Range(xlWorkSheet.Cells(iRowEnd, iColStart), xlWorkSheet.Cells(iRowEnd, iColEnd))

        xlRange.Borders(xlDiagonalDown).LineStyle = xlNone
        xlRange.Borders(xlDiagonalUp).LineStyle = xlNone
        With xlRange.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeTop)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With xlRange.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        
        xlWorkSheet.Cells(iRowEnd, 3).Value = "SUBTOTAL"
        xlWorkSheet.Range(xlWorkSheet.Cells(iRowEnd, 3), xlWorkSheet.Cells(iRowEnd, 3)).Font.Bold = True
        '****************************************

        '****************************************
        'Format columns that are not the default
        iCol = iColEnd
        'For x1 = 1 To 3
            'xlWorkSheet.Columns(iCol).Style = "Percent"
            'xlWorkSheet.Columns(iCol).NumberFormat = "0.00%"
            'iCol = iCol - 4
        'Next x1

        'iCol = iColEnd - 6
        'For x = 1 To 3
            'xlWorkSheet.Columns(iCol).NumberFormat = "#,##0.0_);[Red](#,##0.0)"
            'iCol = iCol - 8
        'Next x

        'Autofit worksheets
        xlWorkSheet.Columns.AutoFit

        'Mover Cursor to default position and Freeze Panes
        'xlWorkSheet.Range(xlWorkSheet.Cells(iRowStart, iColStart), xlWorkSheet.Cells(iRowStart, iColStart)).Select
        xlWorkSheet.Range("B3").Select
        xlApp.ActiveWindow.FreezePanes = True
        '****************************************

        '****************************************
        'Set Header and Print Setup
        'With xlApp.ActiveSheet.PageSetup
            '.PrintTitleRows = "$3:$3"
            '.PrintTitleColumns = ""
        'End With
        xlApp.ActiveSheet.PageSetup.PrintArea = ""
        With xlApp.ActiveSheet.PageSetup
            '.LeftHeader = "&D"
            .LeftHeader = "Report Date: " & Month(Now()) & "/" & Day(Now()) & "/" & Year(Now())

            .CenterHeader = "&""Arial,Bold""&12&A" & "Report Title"
            '.RightHeader = "Page &P of &N"

            '.LeftFooter = "Report Version and Path"
            .LeftFooter = "&8" & strMy_App_Title & " " & "Version: " & DLookup("fe_version_number", "tbl_fe_version")

            '.CenterFooter = "Meisner Electric, Inc. - Confidential"

            .RightFooter = "Report Subject"
            '.RightFooter = "&8" & "Menu: 1.5.3. - Other"
            '.RightFooter = "&8" & "Menu: " & Me.Caption

            '.LeftMargin = xlApp.Application.InchesToPoints(0.75)
            '.RightMargin = xlApp.Application.InchesToPoints(0.75)
            '.TopMargin = xlApp.Application.InchesToPoints(1)
            '.BottomMargin = xlApp.Application.InchesToPoints(1)
            '.HeaderMargin = xlApp.Application.InchesToPoints(0.5)
            '.FooterMargin = xlApp.Application.InchesToPoints(0.5)
            '.PrintHeadings = False
            '.PrintGridlines = False
            '.PrintComments = xlPrintNoComments
            ''.PrintQuality = 600
            '.CenterHorizontally = False
            '.CenterVertically = False

            '.Orientation = xlLandscape
            '.Orientation = xlPortrait

            '.Draft = False

            '.PaperSize = xlPaperLetter
            '.PaperSize = xlPaperLegal

            '.FirstPageNumber = xlAutomatic
            '.Order = xlDownThenOver
            '.BlackAndWhite = False
            '.Zoom = False
            '.FitToPagesWide = 1
            '.FitToPagesTall = False
            '.PrintErrors = xlPrintErrorsDisplayed
        End With

    Else
        MyRst.Close
        Set MyRst = Nothing
        'Set Rs1 = Nothing
        Set DAODb = Nothing
    End If

'****************************************
'****************************************
'Next data block goes here


'****************************************
'****************************************

    'xlapp.Application.ActivePrinter = Active_Printer

    '****************************************
    ' Save a copy of Excel on a Hard Drive or network location
    'If Excel_Archive = "Yes" Then
        'Dim strReportMonth As String
        'strReportMonth = DLookup("Date_Report_Month", "tbl_Report_Info")
        'Add Protection to the workbook
        ''xlWorkSheet.Protect (strReportMonth)
        '****************************************
        'Choose File Name
            'xlWorkBook.SaveAs Archive_Dir & "\Monthly_Billing_" & strReportMonth & ".xls"
        'Or use Saved File Name
            'xlWorkBook.SaveAs Archive_Dir & "\" & strSaved_fName
        '****************************************

        'xlWorkBook.Close

        '****************************************
        'Set the File Attribute to Read Only
        'Choose File Name
            ''Set f = fs.GetFile(Archive_Dir & "\Monthly_Billing_" & strReportMonth & ".xls")
        'Or use Saved File Name
            ''Set f = fs.GetFile(Archive_Dir & "\" & strSaved_fName)
        ''f.Attributes = 1
        '****************************************
    'End If
    '****************************************

    '****************************************
    ' Save a copy of Excel on a Hard Drive or network location
    'strMyFile_Path = xlApp.Application.GetSaveAsFilename(strSaved_fName, fileFilter:="Excel Files (*.xls), *.xls")

    'If strMyFile_Path <> False Then
        'xlApp.ActiveWorkbook.SaveAs FileName:=strMyFile_Path, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    'End If
    '****************************************

Exit_sExcel_SubRoutine:
    'xlapp.Quit
    Set xlApp = Nothing
    Set xlWorkBook = Nothing
    Set xlWorkSheet = Nothing
    Set xlRange = Nothing

    Exit Sub

Err_sExcel_SubRoutine:
    MsgBox Err.Description
    Resume Exit_sExcel_SubRoutine

The only new section is the sort part which you can find by searching for "'Change Sort Order"

Thank you,

 

[namliam]

The only thing I can think of right now is that I think Range is part of the Sheet not the application.

Perhaps
xlWorkSheet.Range ??

If not that... than I am stuck...

 

[Kenln]

Yeah, I tried that yesterday. No luck with that either.

Microsoft talk about this happening when I use a 'name' option, which I don't. So???? I'm back to square one.

Any ideas how to put this code in Excel (which I can do) and call it from Access (which I do not know how to do).

Thanks.

 

[Kenln]

Okay,

Now I am confused...
As stated before I use this code often without problems. The only new (added) code is:

        xlApp.Range(xlWorkSheet.Cells(1, 1), xlWorkSheet.Cells(iRowEnd - 1, iColEnd)).Sort _
            Key1:=Range("A2"), Order1:=xlAscending, _
            Key2:=Range("B2"), Order2:=xlAscending, _
            Key3:=Range("C2"), Order3:=xlAscending, _
            Header:=xlYes, _
            OrderCustom:=1, _
            MatchCase:=False, _
            Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal, _
            DataOption2:=xlSortNormal, _
            DataOption3:=xlSortNormal

Good so far except with this extra code I can only run it once and once only. Hmmm.

So I checked the task manager.
Without this code Excel.exe does show in Processes and terminate when I close the Excel Application.

By adding just this line above, doing nothing else, when I close Excel the excel.exe process DOES NOT TERMINATE. Rather it stayS open until I close MSAccess.

What is special about this code?

 

[namliam]

Perhaps the fact that you have xlApp.Range??

Other than that... nothing unussual about it.

 

[chergh]

I've had this error quite a few times and it can be a pain inthe ass. Try this and see if it helps:

xlworksheet.range("A1").currentregion.Sort _
            Key1:=xlworksheet.Range("A2"), Order1:=xlAscending, _
            Key2:=xlworksheet.Range("B2"), Order2:=xlAscending, _
            Key3:=xlworksheet.Range("C2"), Order3:=xlAscending, _
            Header:=xlYes, _
            OrderCustom:=1, _
            MatchCase:=False, _
            Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal, _
            DataOption2:=xlSortNormal, _
            DataOption3:=xlSortNormal

 

[Kenln]

I found it in another forum.... Yeah!!!!!

With xlWorkSheet
     .Range(xlWorkSheet.Cells(1, 1), xlWorkSheet.Cells(iRowEnd - 1, iColEnd)).Sort _
     Key1:=[COLOR="Red"][B].[/B][/COLOR]Range("A2"), Order1:=xlAscending, _
     Key2:=[COLOR="red"][B].[/B][/COLOR]Range("B2"), Order2:=xlAscending, _
     Key3:=[B][COLOR="red"].[/COLOR][/B]Range("C2"), Order3:=xlAscending, _
     Header:=xlYes, _
     OrderCustom:=1, _
     MatchCase:=False, _
     Orientation:=xlTopToBottom, _
     DataOption1:=xlSortNormal, _
     DataOption2:=xlSortNormal, _
     DataOption3:=xlSortNormal
End With

The big change (addition) was the full stop (period) before the Range key words, noted in red.

It worked on the first try.

Thanks guys.

 

[namliam]

makes sence... somehow...

YOu have to continualy refer to excel... even inside the excel command. Like chergh said...