Excel staying in memory problem.

???????????
https://www.experts-exchange.com/questions/21251430/Save-and-Close-Excel-Document-from-vb.html?query=Excel+staying+in+memory+problem&clearTAFilter=true

What's up with the ????????

I did a search and didn't come up with what I was looking for in the Access topic (which is the only place I searched).  I didn't think of searching in the VB section.  

I'll give that a shot and see if it works.

Actually,  what's different between that code and mine (except for the variable names)?  This one just saves the first file as a different name (correct?).  The only difference I really see is the DisplayAlerts and Excel.visible.  I need the Excel.visible to be false so that the Input boxes later in the code will have focus.  With Excel visible, it doesn't happen.

Dim mobjExcel
Dim wb

Set mobjExcel = CreateObject("Excel.Application")
mobjExcel.Visible = True
Set wb = mobjExcel.Workbooks.Open("c:\test.xls")

'do some sorting processing

mobjExcel.DisplayAlerts = False

'save file in "B"
wb.SaveAs Filename:="c:\new.xls"

'close file
wb.Close

mobjExcel.DisplayAlerts = True
mobjExcel.Quit

Set wb = Nothing
Set mobjExcel = Nothing

You might try getting rid of either you early binding or late binding of Excel it could be the cause of your problem?

    Dim xlApp As Excel.Application                  <=================== Early
    'Set xlApp = New Excel.Application
    Set xlApp = CreateObject("Excel.Application")   <=================Late

Since you used early binding "Dim xlApp As Excel.Application" there should be no need to use late binding as well "Set xlApp = CreateObject("Excel.Application")".

Just try using the object from there.

Dim xlApp As Excel.Application

ampapa,

I tried just using:
Dim xlApp As Excel.Application and get the following error on anything that references xlApp.
Object Variable or With block variable not set

When I tried to use just the Set xlApp = CreateObject("Excel.Application"), it still left a copy of Excel in memory.

Any other suggestions?

Thanks,

Jeremy

Here is how I close an Excel workbook. This code has work excelently (pun intended) for me for years.


Sub Excel_CloseWorkBook(xlApp As Excel.Application, Optional bSaveChanges As Boolean = False)
Dim wb As Excel.Workbook
    On Error Resume Next
    If xlApp.Name > "" Then
    End If
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
        For Each wb In xlApp.Workbooks         'Close all open workbooks
            wb.Close bSaveChanges
        Next wb
    xlApp.UserControl = False
    Set xlApp = Nothing
End Sub

and this is how I open them


Function Excel_OpenWorkBook(Path As String, Optional UpdateLinks As Boolean = False, Optional password As String = "") As Excel.Application
    Dim xlObj As Excel.Application
    On Error GoTo Excel_OpenWorkBook_err
   
    'You do not need to make the application object visible
    'if you close the file and quit the application
    'later in your code in order to remove these objects
    'from memory.
   
    Set xlObj = Excel_OpenWorkBookHidden(Path, UpdateLinks, password)
   
    If xlObj.Name > "" Then xlObj.Visible = True
   
    Set Excel_OpenWorkBook = xlObj
Excel_OpenWorkBook_exit:
    Exit Function
Excel_OpenWorkBook_err:
    ReportError Err.Number, Err.Description, "Excel_OpenWorkBook", "Excel_mod", "File Name=" & Path
    Set Excel_OpenWorkBook = Nothing
    Resume Excel_OpenWorkBook_exit
End Function

Function Excel_OpenWorkBookHidden(Path As String, Optional UpdateLinks As Boolean = False, Optional password As String = "") As Excel.Application
    Dim xlObj As Excel.Application
       
    On Error GoTo Excel_OpenWorkBookHidden_err
    'Check to see if the file name passed in to the procedure is valid
    If IsNull(Path) Or isDirectory(Path) Or Not FileExists(Path) Then
        MsgBox Path & " isn't a valid path!", vbCritical, "Open Excel Workbook"
        Set Excel_OpenWorkBookHidden = Nothing
        Exit Function
    Else
        Set xlObj = CreateObject("Excel.Application")
   
        'You do not need to make the application object visible
        'if you close the file and quit the application
        'later in your code in order to remove these objects
        'from memory.

        xlObj.Workbooks.Open Path, UpdateLinks, , , password
        Set Excel_OpenWorkBookHidden = xlObj
    End If
Excel_OpenWorkBookHidden_exit:
    Exit Function
Excel_OpenWorkBookHidden_err:
    ReportError Err.Number, Err.Description, "Excel_OpenWorkBookHidden", "Excel_mod", "File Name=" & Path
    Set Excel_OpenWorkBookHidden = Nothing
    Resume Excel_OpenWorkBookHidden_exit
End Function


You will need to replace / remove the call to ReportError in the error handlers, but here are the other 'helper' functions this code uses

Function isDirectory(sDir As String) As Boolean
    On Error Resume Next
    isDirectory = (GetAttr(sDir) And vbDirectory) <> 0
    If Err.Number <> 0 Then isDirectory = False
    On Error GoTo 0
End Function

Function FileExists(strFile As String) As Boolean
  ' Comments  : Determines if the file exists
  '             Works for hidden files and folders
  ' Parameters: strFile - file to check
  ' Returns   : True if the file exists, otherwise false
  Dim intAttr As Integer
  Dim errnum As Long
  On Error Resume Next
  'GET THE FILE ATTRIBUTE INSTEAD OF THE LENGTH OF THE FILE NAME
  intAttr = GetAttr(strFile)
  errnum = Err.Number
  FileExists = (Err.Number = 0)
End Function

Lambert

Wow, that could be useful.  :)

One question though, with this, I have to pass the file location to the function, correct?  

With the way mine is setup, the user has to select the first file they want to open and the second file will always be the same.  I have also just added some new code that creates a 3rd file as well.

Can this be done with what you have provided?

Thanks,

Jeremy

Sorry Jeremy,

Typo this should work  'Dim xlApp As New Excel.Application'

Nope.  Still stays in memory.  I've changed some of my code.  Here is an updated copy.

Public Function Kmartkewillbatch()

    'Dim xlApp As Excel.Application
    'Set xlApp = New Excel.Application
    Dim xlApp As New Excel.Application
    'Set xlApp = CreateObject("Excel.Application")
    Dim WB1 As Workbook, WB2 As Workbook
    Dim WS1 As Worksheet, WS2 As Worksheet
    xlApp.Visible = True
    xlApp.ScreenUpdating = True
    xlApp.Application.Dialogs(xlDialogOpen).Show
    Set WB1 = xlApp.ActiveWorkbook
    Set WS1 = WB1.Worksheets("STORE INFO")
   
    Set xlApp2 = Excel.Application
    DoCmd.Hourglass True
    xlApp2.Workbooks.Open FileName:="\\atlfile1\shared\Kewill\batch template.xls"
    Set WB2 = xlApp2.ActiveWorkbook
    Set WS2 = WB2.ActiveSheet
   
    WB1.Activate
    WS1.Activate
    WS1.Cells.Select
    xlApp.Selection.Sort Key1:=WS1.Range("R2"), Order1:=xlDescending, Key2:=WS1.Range("B2") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
   
    WS1.Columns("C:F").Select
    xlApp.Selection.Insert Shift:=xlToRight
   
    'Range("C2:C" & Range("A65000").End(xlUp).Row).Value = InputBox("Please enter the value.")
   
    WS1.Range("C2:C" & WS1.Range("A65000").End(xlUp).Row).Value = "K"
    WS1.Range("D2:D" & WS1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&RC[-2]"
    WS1.Range("E2:E" & WS1.Range("A65000").End(xlUp).Row).Value = "KMART#"
    WS1.Range("F2:F" & WS1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&"" ""&RC[-4]"
   
    WS1.Range("F1").Activate
    xlApp.Selection.Copy
    xlApp.Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    WS1.Cells.EntireColumn.AutoFit
    WB1.Activate
   
Dim sht As Worksheet, rng As Range
Dim rws As Long, i As Long, x As Long, y As Long
Dim wb As Workbook, sht2 As Worksheet

Set wb = xlApp.Workbooks.Add
Set WB3 = xlApp.ActiveWorkbook
Set WS3 = wb.Worksheets(1)
    WS3.name = "Extra Cartons"
Set rng = WS1.Range("CARTONS")
Set sht = rng.Parent
    WB1.Activate
    WS1.Rows("1:1").Select
    xlApp.Selection.Copy
    WB3.Activate
    WS3.Rows("1:1").Select
    WB3.ActiveSheet.Paste
    WS3.Range("A2").Select
rws = Intersect(rng, sht.UsedRange).Rows.Count
i = 1: y = 2

While i <= rws
    If IsNumeric(sht.Cells(i, rng.Column).Value) Then
        If sht.Cells(i, rng.Column).Value > 1 Then
            For x = 1 To sht.Cells(i, rng.Column).Value - 1
                sht.Rows(i).Copy WS3.Rows(y)
                y = y + 1
            Next
        End If
    End If
    i = i + 1
Wend
    WS3.Columns("F:F").Select
    WB1.Names.Add name:="SHIPTONAME", RefersToR1C1:= _
        "='STORE INFO'!C6"

    WS1.Range("SHIPTONAME").Copy WS2.Range("SHIPTONAME")
    WS2.Range("C1").Value = "Ship To Name"
   
    WS1.Range("ADDRESS1").Copy WS2.Range("ADDRESS1")
   
    WS1.Range("CITY").Copy WS2.Range("CITY")
    WS1.Range("STATE").Copy WS2.Range("STATE")
    WS1.Range("ZIP").Copy WS2.Range("ZIP")
    WS1.Range("PURCHASEORDER").Copy WS2.Range("PURCHASEORDER")
    WS1.Range("ORDERNUMBER").Copy WS2.Range("ORDERNUMBER")
    WS2.Activate
   
       
    Dim rngCARRIER As Range
    Set rngCARRIER = WS2.Range("B2:B" & Range("c65000").End(xlUp).Row)
    rngCARRIER.Value = InputBox("Please enter Carrier")


   
    Dim rngATTENTION As Range
    Set rngATTENTION = WS2.Range("D2:D" & Range("C65000").End(xlUp).Row)
    rngATTENTION.Value = "Receiving"
   
    Dim rngWeight As Range
    Set rngWeight = WS2.Range("L2:L" & Range("C65000").End(xlUp).Row)
    rngWeight.Value = InputBox("Please enter weight")
   
    Dim rngDEPARTMENT As Range
    Set rngDEPARTMENT = WS2.Range("R2:R" & Range("C65000").End(xlUp).Row)
    rngDEPARTMENT = InputBox("Please enter Department")
   
    Dim rngPAYFLAG As Range
    Set rngPAYFLAG = WS2.Range("M2:M" & Range("C65000").End(xlUp).Row)
    rngPAYFLAG = InputBox("Please enter Pay Flag")
   
    WS2.Cells.Select
    WS2.Cells.EntireColumn.AutoFit
    WS2.Range("A1").Select
   
    Dim strFileName As String
    strFileName = "\\atlfile1\shared\Kewill\KewillBatch.csv"
     If Len(Dir(strFileName)) > 0 Then
       Kill strFileName
    End If
   
    WB2.Activate
    WS2.Cells.EntireColumn.AutoFit
   
    WB2.SaveAs FileName:="\\atlfile1\shared\Kewill\KewillBatch.csv", FileFormat:=xlCSV _
      , CreateBackup:=False

    WB1.Activate
    WB1.Close (False)
    WS2.Activate
    WS2.Range("A2").Select
    WS2.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Delete Shift:=xlUp
    WS2.Range("A2").Select
    'WB2.Close (False)
    'xlApp.Workbooks.Open FileName:=WB2
    WB3.Activate
    WS3.Activate
    WS3.Cells.Select
    WS3.Cells.EntireColumn.AutoFit
    WB3.Activate
   
    WS3.Columns("F:F").Select
    WS3.Names.Add name:="SHIPTONAME", RefersToR1C1:= _
        "='Extra Cartons'!C6"
    WS3.Columns("G:G").Select
    WS3.Names.Add name:="PURCHASEORDER", RefersToR1C1:= _
        "='Extra Cartons'!C7"
    WS3.Columns("A:A").Select
    WS3.Names.Add name:="ORDERNUMBER", RefersToR1C1:= _
        "='Extra Cartons'!C1"
    WS3.Columns("X:X").Select
    WS3.Names.Add name:="CITY", RefersToR1C1:="='Extra Cartons'!C24"
    WS3.Columns("Y:Y").Select
    WS3.Names.Add name:="STATE", RefersToR1C1:= _
        "='Extra Cartons'!C25"
    WS3.Columns("Z:Z").Select
    WS3.Names.Add name:="ZIP", RefersToR1C1:="='Extra Cartons'!C26"
    WS3.Columns("W:W").Select
    WS3.Names.Add name:="ADDRESS1", RefersToR1C1:= _
        "='Extra Cartons'!C23"


    WS3.Range("SHIPTONAME").Copy WS2.Range("SHIPTONAME")
    WS2.Range("C1").Value = "Ship To Name"
   
    WS3.Range("ADDRESS1").Copy WS2.Range("ADDRESS1")
   
    WS3.Range("CITY").Copy WS2.Range("CITY")
    WS3.Range("STATE").Copy WS2.Range("STATE")
    WS3.Range("ZIP").Copy WS2.Range("ZIP")
    WS3.Range("PURCHASEORDER").Copy WS2.Range("PURCHASEORDER")
    WS3.Range("ORDERNUMBER").Copy WS2.Range("ORDERNUMBER")
    WS2.Activate
   
       
    Set rngCARRIER = WS2.Range("B2:B" & Range("c65000").End(xlUp).Row)
    rngCARRIER.Value = InputBox("Please enter Carrier")

    Set rngATTENTION = WS2.Range("D2:D" & Range("C65000").End(xlUp).Row)
    rngATTENTION.Value = "Receiving"
   
    Set rngWeight = WS2.Range("L2:L" & Range("C65000").End(xlUp).Row)
    rngWeight.Value = InputBox("Please enter weight")
   
    Set rngDEPARTMENT = WS2.Range("R2:R" & Range("C65000").End(xlUp).Row)
    rngDEPARTMENT = InputBox("Please enter Department")
   
    Set rngPAYFLAG = WS2.Range("M2:M" & Range("C65000").End(xlUp).Row)
    rngPAYFLAG = InputBox("Please enter Pay Flag")
   
   
    WB3.Activate
    WS3.Cells.EntireColumn.AutoFit
    WS3.Range("A1").Select
   
   
    strFileName = "\\atlfile1\shared\Kewill\KewillBatch2.csv"
     If Len(Dir(strFileName)) > 0 Then
       Kill strFileName
    End If
   
   
    WB2.SaveAs FileName:="\\atlfile1\shared\Kewill\KewillBatch2.csv", FileFormat:=xlCSV _
      , CreateBackup:=False
   
   
   
    WB2.Close (False)
    WB3.Close (False)
   
    Set WB1 = Nothing
    Set WB2 = Nothing
    Set WB3 = Nothing
    Set WS1 = Nothing
    Set WS2 = Nothing
    Set WS3 = Nothing
    xlApp.Quit

    Set xlApp = Nothing
   
    DoCmd.Hourglass False
    MsgBox ("Batch Process complete.  You can get the batch file from S:\Kewill\KewillBatch.csv"), , "Processing Complete"
   
End Function

Try, after:
Set xlApp = Nothing

adding:
DoEvents

That relinquishes control back to the operating system to complete background tasks.
That may help to clear the Excel "ghost"

What's the purpose for - xlApp.Application.Dialogs(xlDialogOpen).Show, does the user really need to select this file? It appears that when I ran this it opened the file 'hidden' if I remember correctly. Maybe you could try opening this file differently?

Hi Jeremy,

The problem was because there were a feww errors in the coding. These errors weren't enought to make the code fall over, but they did cause an automation error. I have listed the errors here, so you can see them for yourself:

1. WB3 was not dim'ed. To check that you have got all variables you used dim'ed and spelt correctly, always use "Option Explicit" as the first line of every module you work in.

2. "    Set xlApp2 = Excel.Application" - New keyword missing. Although you don't need to create a second xl application at all, so you can delete this line totally, and just use the one instance of excel.

I have also done a bit of cleaning on the code, and it still needs some more, but at the moment it should be OK. Get back to me if it doesn't work.

MUK.

Option Explicit
Public Function Kmartkewillbatch()

    'Dim xlApp As Excel.Application
    'Set xlApp = New Excel.Application
    Dim xlApp As New Excel.Application
    'Set xlApp = CreateObject("Excel.Application")
    Dim WB1 As Workbook, WB2 As Workbook
    Dim WS1 As Worksheet, WS2 As Worksheet
    xlApp.Visible = True
    xlApp.ScreenUpdating = True
    xlApp.Application.Dialogs(xlDialogOpen).Show
    Set WB1 = xlApp.ActiveWorkbook
    Set WS1 = WB1.Worksheets("STORE INFO")
   
    DoCmd.Hourglass True
    Set WB2 = xlApp.Workbooks.Open(FileName:="\\atlfile1\shared\Kewill\batch template.xls")
    Set WS2 = WB2.ActiveSheet
   
    WB1.Activate
    WS1.Activate
    WS1.Cells.Sort Key1:=WS1.Range("R2"), Order1:=xlDescending, Key2:=WS1.Range("B2") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
   
    WS1.Columns("C:F").Insert Shift:=xlToRight
   
    'Range("C2:C" & Range("A65000").End(xlUp).Row).Value = InputBox("Please enter the value.")
   
    WS1.Range("C2:C" & WS1.Range("A65000").End(xlUp).Row).Value = "K"
    WS1.Range("D2:D" & WS1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&RC[-2]"
    WS1.Range("E2:E" & WS1.Range("A65000").End(xlUp).Row).Value = "KMART#"
    WS1.Range("F2:F" & WS1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&"" ""&RC[-4]"
   
    WS1.Range("F1").Activate
    xlApp.Selection.Copy
    xlApp.Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    WS1.Cells.EntireColumn.AutoFit
    WB1.Activate
   
Dim sht As Worksheet, rng As Range
Dim rws As Long, i As Long, x As Long, y As Long
Dim WB3 As Worksheet, sht2 As Worksheet

Set WB3 = xlApp.Workbooks.Add
Set WS3 = WB3.Worksheets(1)
    WS3.Name = "Extra Cartons"
Set rng = WS1.Range("CARTONS")
Set sht = rng.Parent
    WB1.Activate
    WS1.Rows("1:1").Select
    xlApp.Selection.Copy
    WB3.Activate
    WS3.Rows("1:1").Select
    WB3.ActiveSheet.Paste
    WS3.Range("A2").Select
rws = Intersect(rng, sht.UsedRange).Rows.Count
i = 1: y = 2

While i <= rws
    If IsNumeric(sht.Cells(i, rng.Column).Value) Then
        If sht.Cells(i, rng.Column).Value > 1 Then
            For x = 1 To sht.Cells(i, rng.Column).Value - 1
                sht.Rows(i).Copy WS3.Rows(y)
                y = y + 1
            Next
        End If
    End If
    i = i + 1
Wend
    WS3.Columns("F:F").Select
    WB1.Names.Add Name:="SHIPTONAME", RefersToR1C1:= _
        "='STORE INFO'!C6"

    WS1.Range("SHIPTONAME").Copy WS2.Range("SHIPTONAME")
    WS2.Range("C1").Value = "Ship To Name"
   
    WS1.Range("ADDRESS1").Copy WS2.Range("ADDRESS1")
   
    WS1.Range("CITY").Copy WS2.Range("CITY")
    WS1.Range("STATE").Copy WS2.Range("STATE")
    WS1.Range("ZIP").Copy WS2.Range("ZIP")
    WS1.Range("PURCHASEORDER").Copy WS2.Range("PURCHASEORDER")
    WS1.Range("ORDERNUMBER").Copy WS2.Range("ORDERNUMBER")
    WS2.Activate
   
    Dim rngCARRIER As Range
    Set rngCARRIER = WS2.Range("B2:B" & Range("c65000").End(xlUp).Row)
    rngCARRIER.Value = InputBox("Please enter Carrier")

    Dim rngATTENTION As Range
    Set rngATTENTION = WS2.Range("D2:D" & Range("C65000").End(xlUp).Row)
    rngATTENTION.Value = "Receiving"
   
    Dim rngWeight As Range
    Set rngWeight = WS2.Range("L2:L" & Range("C65000").End(xlUp).Row)
    rngWeight.Value = InputBox("Please enter weight")
   
    Dim rngDEPARTMENT As Range
    Set rngDEPARTMENT = WS2.Range("R2:R" & Range("C65000").End(xlUp).Row)
    rngDEPARTMENT = InputBox("Please enter Department")
   
    Dim rngPAYFLAG As Range
    Set rngPAYFLAG = WS2.Range("M2:M" & Range("C65000").End(xlUp).Row)
    rngPAYFLAG = InputBox("Please enter Pay Flag")
   
    WS2.Cells.Select
    WS2.Cells.EntireColumn.AutoFit
    WS2.Range("A1").Select
   
    Dim strFileName As String
    strFileName = "\\atlfile1\shared\Kewill\KewillBatch.csv"
    If Len(Dir(strFileName)) > 0 Then
       Kill strFileName
    End If
   
    WB2.Activate
    WS2.Cells.EntireColumn.AutoFit
   
    WB2.SaveAs FileName:="\\atlfile1\shared\Kewill\KewillBatch.csv", FileFormat:=xlCSV _
      , CreateBackup:=False

    WB1.Activate
    WB1.Close False
    WS2.Activate
    WS2.Range("A2", ActiveCell.SpecialCells(xlLastCell)).Delete Shift:=xlUp
    WS2.Range("A2").Select
    'WB2.Close (False)
    'xlApp.Workbooks.Open FileName:=WB2
    WB3.Activate
    WS3.Activate
    WS3.Cells.Select
    WS3.Cells.EntireColumn.AutoFit
    WB3.Activate
   
    WS3.Columns("F:F").Select
    WS3.Names.Add Name:="SHIPTONAME", RefersToR1C1:= _
        "='Extra Cartons'!C6"
    WS3.Columns("G:G").Select
    WS3.Names.Add Name:="PURCHASEORDER", RefersToR1C1:= _
        "='Extra Cartons'!C7"
    WS3.Columns("A:A").Select
    WS3.Names.Add Name:="ORDERNUMBER", RefersToR1C1:= _
        "='Extra Cartons'!C1"
    WS3.Columns("X:X").Select
    WS3.Names.Add Name:="CITY", RefersToR1C1:="='Extra Cartons'!C24"
    WS3.Columns("Y:Y").Select
    WS3.Names.Add Name:="STATE", RefersToR1C1:= _
        "='Extra Cartons'!C25"
    WS3.Columns("Z:Z").Select
    WS3.Names.Add Name:="ZIP", RefersToR1C1:="='Extra Cartons'!C26"
    WS3.Columns("W:W").Select
    WS3.Names.Add Name:="ADDRESS1", RefersToR1C1:= _
        "='Extra Cartons'!C23"


    WS3.Range("SHIPTONAME").Copy WS2.Range("SHIPTONAME")
    WS2.Range("C1").Value = "Ship To Name"
   
    WS3.Range("ADDRESS1").Copy WS2.Range("ADDRESS1")
   
    WS3.Range("CITY").Copy WS2.Range("CITY")
    WS3.Range("STATE").Copy WS2.Range("STATE")
    WS3.Range("ZIP").Copy WS2.Range("ZIP")
    WS3.Range("PURCHASEORDER").Copy WS2.Range("PURCHASEORDER")
    WS3.Range("ORDERNUMBER").Copy WS2.Range("ORDERNUMBER")
    WS2.Activate
   
       
    Set rngCARRIER = WS2.Range("B2:B" & Range("c65000").End(xlUp).Row)
    rngCARRIER.Value = InputBox("Please enter Carrier")

    Set rngATTENTION = WS2.Range("D2:D" & Range("C65000").End(xlUp).Row)
    rngATTENTION.Value = "Receiving"
   
    Set rngWeight = WS2.Range("L2:L" & Range("C65000").End(xlUp).Row)
    rngWeight.Value = InputBox("Please enter weight")
   
    Set rngDEPARTMENT = WS2.Range("R2:R" & Range("C65000").End(xlUp).Row)
    rngDEPARTMENT = InputBox("Please enter Department")
   
    Set rngPAYFLAG = WS2.Range("M2:M" & Range("C65000").End(xlUp).Row)
    rngPAYFLAG = InputBox("Please enter Pay Flag")
   
   
    WB3.Activate
    WS3.Cells.EntireColumn.AutoFit
    WS3.Range("A1").Select
   
   
    strFileName = "\\atlfile1\shared\Kewill\KewillBatch2.csv"
    If Len(Dir(strFileName)) > 0 Then
       Kill strFileName
    End If
   
   
    WB2.SaveAs FileName:="\\atlfile1\shared\Kewill\KewillBatch2.csv", FileFormat:=xlCSV _
      , CreateBackup:=False
   
    WB2.Close False
    WB3.Close False
   
    Set WB1 = Nothing
    Set WB2 = Nothing
    Set WB3 = Nothing
    Set WS1 = Nothing
    Set WS2 = Nothing
    Set WS3 = Nothing
    xlApp.Quit

    Set xlApp = Nothing
   
    DoCmd.Hourglass False
    MsgBox ("Batch Process complete.  You can get the batch file from S:\Kewill\KewillBatch.csv"), , "Processing Complete"
   
End Function

dannywareham,

Tried adding the DoEvents, but Excel is still showing.


ampapa,

xlApp.Application.Dialogs(xlDialogOpen).Show is what prompts the user for the file to open.  This file will change so that is why the user has to select it.  

MalicUK,

Tried your code and it it still leaving Excel in memory.

I did change the following:

Dim WB3 As Worksheet, sht2 As Worksheet

to

Dim WB3 As Workbook
Dim WS3 As Worksheet   'This wasn't dim'ed either.
Dim sht2 As Worksheet


Also,

Every other time I run this this, I get the error: "The remote machine does not exist or is unavailable" on this line
rws = Intersect(rng, sht.UsedRange).Rows.Count

This is code from the duplicate function you gave me last week.

Thanks,

Jeremy

From looking around, I've found that everytime you use CreateObject, you're creating a new instance of Excel-- that's why you're seeing the "ghost" versions.  If you want to use a single instance of Excel use GetObject.

e.g.,

Sub startExcel()

    Dim myExcelApp As Excel.Application
    Dim myWkbk As Excel.Workbook
       
    On Error GoTo err_startExcel
   
    Set myExcelApp = GetObject(, "Excel.Application")
   
    myExcelApp.Visible = True
    Set myWkbk = myExcelApp.Workbooks.Add()
   
    'Do any processing
'etc

If for some very strange reason you want to use late-binding you can change the variable definitions to OBJECT

Would this be the line causing it, since Excel is opened first when the user selects the first file?
Set WB2 = xlApp.Workbooks.Open(FileName:="\\atlfile1\shared\Kewill\batch template.xls")

Danny, that is not quite true. It creates that one instance of excel for that procedure. If the instance is killed off then it will disappear, unless an object in that instance is still in use. Using GetObject is alot trickier, and I would always suggest using CreateObject.

Automation is a tricky one until you get used to it. I use it all the time now in alot of what I do, and I know from plenty of experience, that one tinyest thing forgotten can leave the instance of excel running.

In this respect, I am totally re-writing your code how I would do it, and hopefully we can get to the bottom of the issue.

I have about a dozen other Excel automation items in my access app, but this is the first time that this has happened.

I'm curious to see the differences in the code you suggest.

I did change a few things already (storing the data from the Input Boxes so they can be reused the 2nd time, instead of having the user enter them twice).

Thanks,

Jeremy

Hi Jeremy,

Here is what I have got. I can't bee 100% that is will work because I can't test. However it should be OK.

The main changes are in standardising the format of the code, and the way variables are definied. The Dim's and Set's are as much as possible together at the top, and there are no excessive or extra variables. When an Excel variable is Dim'ed then the word Excel. is put before the object it is being dim'ed as.

I hope it works OK for you.

MUK.

Option Explicit

Public Function Kmartkewillbatch()

Dim xlApp As New Excel.Application
xlApp.Visible = True
xlApp.ScreenUpdating = True

Dim wb1 As Excel.Workbook, ws1 As Excel.Worksheet, rg1 As Excel.Range
Dim wb2 As Excel.Workbook, ws2 As Excel.Worksheet
Dim wb3 As Excel.Workbook, ws3 As Excel.Worksheet
Dim rws As Long, i As Long, x As Long, y As Long
Dim strCARRIER As String, strATTENTION As String, strWEIGHT As String, strDEPARTMENT As String, strPAYFLAG As String
Dim strFileName As String

Set wb1 = xlApp.Workbooks.Open(xlApp.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please choose file to open", ButtonText:="Open"))
Set ws1 = wb1.Sheets("STORE_INFO")
Set rg1 = ws1.Range("CARTONS")

Set wb2 = xlApp.Workbooks.Open(FileName:="\\atlfilehard\kewill\batch template.xls")
Set ws2 = wb2.ActiveSheet

Set wb3 = xlApp.Workbooks.Add
Set ws3 = wb3.Sheets(1)

i = 1: y = 2

'Format ws1
    wb1.Activate
    ws1.Activate
    ws1.Cells.Sort Key1:=ws1.Range("A2"), Order1:=xlDescending, Key2:=ws1.Range("B2"), Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    ws1.Columns("C:F").Insert Shift:=xlToRight
    ws1.Range("C2:C" & ws1.Range("A65000").End(xlUp).Row).Value = "K"
    ws1.Range("D2:D" & ws1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&RC[-2]"
    ws1.Range("E2:E" & ws1.Range("A65000").End(xlUp).Row).Value = "KMART#"
    ws1.Range("F2:F" & ws1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&" & Chr(34) & " " & Chr(34) & "&RC[-4]"
'The next line is the same as doing a copy and paste values
    ws1.Range("F1").Formula = ws1.Range("F1").Value
    ws1.Columns.AutoFit

'Create Extra cartons workbook
    ws3.Name = "Extra Cartons"
    ws1.Rows("1:1").Copy ws3.Rows("1:1")
    rws = Intersect(rg1, ws1.UsedRange).Rows.Count
   
    While i <= rws
        If IsNumeric(ws1.Cells(i, rg1.Column).Value) Then
            If ws1.Cells(i, rg1.Column).Value > 1 Then
                For x = 1 To ws1.Cells(i, rg1.Column).Value - 1
                    ws1.Rows(i).Copy ws3.Rows(y)
                    y = y + 1
                Next
            End If
        End If
        i = i + 1
    Wend

'Copy info from ws1 to ws2 and format
    wb1.Names.Add Name:="SHIPTONAME", RefersTo:="='STORE INFO'!C6"
    ws1.Range("SHIPTONAME").Copy ws2.Range("SHIPTONAME")
    ws2.Range("C1").Value = "Ship To Name"
    ws1.Range("ADDRESS1").Copy ws2.Range("ADDRESS1")
    ws1.Range("CITY").Copy ws2.Range("CITY")
    ws1.Range("STATE").Copy ws2.Range("STATE")
    ws1.Range("ZIP").Copy ws2.Range("ZIP")
    ws1.Range("PURCHASEORDER").Copy ws2.Range("PURCHASEORDER")
    ws1.Range("ORDERNUMBER").Copy ws2.Range("ORDERNUMBER")
   
    strCARRIER = InputBox("Please Enter Carrier")
    strWEIGHT = InputBox("Please Enter Weight")
    strDEPARTMENT = InputBox("Please Enter Department")
    strPAYFLAG = InputBox("Please Enter Pay Flag")
   
    ws2.Range("B2:B" & Range("C65000").End(xlUp).Row).Value = strCARRIER
    ws2.Range("D2:D" & Range("C65000").End(xlUp).Row).Value = "Receiving"
    ws2.Range("L2:L" & Range("C65000").End(xlUp).Row).Value = strWEIGHT
    ws2.Range("R2:R" & Range("C65000").End(xlUp).Row).Value = strDEPARTMENT
    ws2.Range("M2:M" & Range("C65000").End(xlUp).Row).Value = strPAYFLAG
    ws2.Columns.AutoFit

'Delete old file
    strFileName = "\\atlfile1\shared\kewill\KewillBatch.csv"
    If Len(Dir(strFileName)) > 0 Then
        Kill strFileName
    End If

'Save wb2, close wb1
    wb2.SaveAs FileName:=strFileName, FileFormat:=xlCSV
    wb1.Close False
    ws2.Range("A2", ActiveCell.SpecialCells(xlLastCell)).Delete Shift:=xlUp

'Name and Format wb3
    wb3.Activate
    ws3.Columns.AutoFit
    ws3.Columns("F:F").Select
    ws3.Names.Add Name:="SHIPTONAME", RefersToR1C1:= _
        "='Extra Cartons'!C6"
    ws3.Columns("G:G").Select
    ws3.Names.Add Name:="PURCHASEORDER", RefersToR1C1:= _
        "='Extra Cartons'!C7"
    ws3.Columns("A:A").Select
    ws3.Names.Add Name:="ORDERNUMBER", RefersToR1C1:= _
        "='Extra Cartons'!C1"
    ws3.Columns("X:X").Select
    ws3.Names.Add Name:="CITY", RefersToR1C1:="='Extra Cartons'!C24"
    ws3.Columns("Y:Y").Select
    ws3.Names.Add Name:="STATE", RefersToR1C1:= _
        "='Extra Cartons'!C25"
    ws3.Columns("Z:Z").Select
    ws3.Names.Add Name:="ZIP", RefersToR1C1:="='Extra Cartons'!C26"
    ws3.Columns("W:W").Select
    ws3.Names.Add Name:="ADDRESS1", RefersToR1C1:= _
        "='Extra Cartons'!C23"

'copy back data
    ws3.Range("SHIPTONAME").Copy ws2.Range("SHIPTONAME")
    ws2.Range("C1").Value = "Ship To Name"
    ws3.Range("ADDRESS1").Copy ws2.Range("ADDRESS1")
    ws3.Range("CITY").Copy ws2.Range("CITY")
    ws3.Range("STATE").Copy ws2.Range("STATE")
    ws3.Range("ZIP").Copy ws2.Range("ZIP")
    ws3.Range("PURCHASEORDER").Copy ws2.Range("PURCHASEORDER")
    ws3.Range("ORDERNUMBER").Copy ws2.Range("ORDERNUMBER")

    ws2.Range("B2:B" & Range("C65000").End(xlUp).Row).Value = strCARRIER
    ws2.Range("D2:D" & Range("C65000").End(xlUp).Row).Value = "Receiving"
    ws2.Range("L2:L" & Range("C65000").End(xlUp).Row).Value = strWEIGHT
    ws2.Range("R2:R" & Range("C65000").End(xlUp).Row).Value = strDEPARTMENT
    ws2.Range("M2:M" & Range("C65000").End(xlUp).Row).Value = strPAYFLAG
    ws2.Columns.AutoFit

'Delete old file
    strFileName = "\\atlfile1\shared\kewill\KewillBatch2.csv"
    If Len(Dir(strFileName)) > 0 Then
        Kill strFileName
    End If

'Save wb2, close wb2 and wb3
    wb2.SaveAs FileName:=strFileName, FileFormat:=xlCSV
    wb2.Close False
    wb3.Close False
   
    xlApp.Quit
   
    Set rg1 = Nothing
    Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing
    Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
    Set xlApp = Nothing
End Function

I might suggest stripping out your code to only using the needed functions and routines for creating the excel objects, you have a lot of source to plow through it might help to only look at the necessary pieces and fix the loose reference.

The copy paste and move data is needed overall but until you find what is keeping the reference I would get rid of it.

Also, isn't this out of sync?

    xlApp.Quit
   
    Set rg1 = Nothing
    Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing
    Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
    Set xlApp = Nothing

shouldn't it be in more of a logical order
 
    Set rg1 = Nothing
    Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing
    Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
    xlApp.Quit
    Set xlApp = Nothing

Nope, you quit the app, and then remove all the references to the objects. Never fails for me.

Also, the problem might be from a reference "flapping in the wind", ie a bit of code which actually does something not being referenced back to the xlApp Object, thus causing an RPC Error. I don't think this is the case now, but it is possible. So first of all trying the whole code as I put above is the way forward. Then if that doesn't work we remove lines of code one(or several) at a time until we track down the error.

Much cleaner than mine.  :)

Excel is still staying in memory though.  

Could this be a problem with my machine?  Should I try it on another to rule it out?

Jeremy

I KNEW there had to be a RPC error in there! Change the line:

ws2.Range("A2", ActiveCell.SpecialCells(xlLastCell)).Delete Shift:=xlUp

TO:
ws2.Range("A2", xlApp.ActiveCell.SpecialCells(xlLastCell)).Delete Shift:=xlUp

Changed the line, but no change in the problem.

What about this line

    rws = Intersect(rg1, ws1.UsedRange).Rows.Count

should it be     rws = xlApp.Intersect(rg1, ws1.UsedRange).Rows.Count

Every other time i run the code, i get the error:  "The remote machine does not exist or is unavailable"

This is code from the duplicate function you gave me last week.

Increased points

Yep, that error message is the RPC Automation Error. And yes, that line def should be xlApp...

Ooops, and a couple of great big ones. Both instances of this need to be changed:

    ws2.Range("B2:B" & Range("C65000").End(xlUp).Row).Value = strCARRIER
    ws2.Range("D2:D" & Range("C65000").End(xlUp).Row).Value = "Receiving"
    ws2.Range("L2:L" & Range("C65000").End(xlUp).Row).Value = strWEIGHT
    ws2.Range("R2:R" & Range("C65000").End(xlUp).Row).Value = strDEPARTMENT
    ws2.Range("M2:M" & Range("C65000").End(xlUp).Row).Value = strPAYFLAG

TO:
    ws2.Range("B2:B" & ws2.Range("C65000").End(xlUp).Row).Value = strCARRIER
    ws2.Range("D2:D" & ws2.Range("C65000").End(xlUp).Row).Value = "Receiving"
    ws2.Range("L2:L" & ws2.Range("C65000").End(xlUp).Row).Value = strWEIGHT
    ws2.Range("R2:R" & ws2.Range("C65000").End(xlUp).Row).Value = strDEPARTMENT
    ws2.Range("M2:M" & ws2.Range("C65000").End(xlUp).Row).Value = strPAYFLAG

It's a snowball effect.  

I change that line now I get same error every other time the code runs (The remote machine does not exist or is unavailable") on this line:

    ws2.Range("B2:B" & Range("C65000").End(xlUp).Row).Value = strCARRIER

Excel is still showing in memory after it runs.


Jeremy

see my last post :)

DING, DING, DING, DING!!!!  We have a winner!!!  :)

Excel is no longer showing.  After I posted that last one, I saw the fix before I even noticed your post above it.  

One last question.  Since Excel is the active application during all of this, it doesn't switch back to Access for the Input Box's.
    strCARRIER = InputBox("Please Enter Carrier")
    strWEIGHT = InputBox("Please Enter Weight")
    strDEPARTMENT = InputBox("Please Enter Department")
    strPAYFLAG = InputBox("Please Enter Pay Flag")

Is it possible to have it make the Access app the active window right before these lines?

Last question.   I promise.  :)

Jeremy

Hmm, might just be easier to stick the dims, and the input boxes before you even get to starting excel. Unless that is a problem:

Option Explicit

Public Function Kmartkewillbatch()

Dim strCARRIER As String, strATTENTION As String, strWEIGHT As String, strDEPARTMENT As String, strPAYFLAG As String
    strCARRIER = InputBox("Please Enter Carrier")
    strWEIGHT = InputBox("Please Enter Weight")
    strDEPARTMENT = InputBox("Please Enter Department")
    strPAYFLAG = InputBox("Please Enter Pay Flag")

Dim xlApp As New Excel.Application
xlApp.Visible = True
xlApp.ScreenUpdating = True

Dim wb1 As Excel.Workbook, ws1 As Excel.Worksheet, rg1 As Excel.Range
Dim wb2 As Excel.Workbook, ws2 As Excel.Worksheet
Dim wb3 As Excel.Workbook, ws3 As Excel.Worksheet
Dim rws As Long, i As Long, x As Long, y As Long
...
...

oh yeah.  I guess i can do that too.  

Somewhere along the line something happened and now I'm having a problem where I was adding the named ranges.  Let me figure that out and then I'll post the final code and accept the answer.

Thanks,

Jeremy

Here's what it was

    'wb1.Names.Add name:="SHIPTONAME", RefersTo:="='STORE INFO'!C6"

The R1C1 was removed at some point.  I put that back in and it works now.

    wb1.Names.Add name:="SHIPTONAME", RefersToR1C1:= _
        "='STORE INFO'!C4"


Here is the final code.  Do you want to copy and paste it as a response so I can select it as the Accepted answer?

Thank you for all your help!!!!

Jeremy




Option Compare Database
Option Explicit

Public Function Kmartkewillbatch()

Dim strCARRIER As String, strATTENTION As String, strWEIGHT As String, strDEPARTMENT As String, strPAYFLAG As String
   
    strCARRIER = InputBox("Please Enter Carrier")
    strWEIGHT = InputBox("Please Enter Weight")
    strDEPARTMENT = InputBox("Please Enter Department")
    strPAYFLAG = InputBox("Please Enter Pay Flag")

Dim xlApp As New Excel.Application
xlApp.Visible = True
xlApp.ScreenUpdating = True

Dim wb1 As Excel.Workbook, ws1 As Excel.Worksheet, rg1 As Excel.Range
Dim wb2 As Excel.Workbook, ws2 As Excel.Worksheet
Dim wb3 As Excel.Workbook, ws3 As Excel.Worksheet
Dim rws As Long, i As Long, x As Long, y As Long
Dim strFileName As String

Set wb1 = xlApp.Workbooks.Open(xlApp.GetOpenFileName(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please choose file to open", ButtonText:="Open"))
Set ws1 = wb1.Sheets("STORE INFO")
Set rg1 = ws1.Range("CARTONS")

Set wb2 = xlApp.Workbooks.Open(FileName:="\\atlfile1\shared\kewill\batch template.xls")
Set ws2 = wb2.ActiveSheet

Set wb3 = xlApp.Workbooks.Add
Set ws3 = wb3.Sheets(1)

i = 1: y = 2

'Format ws1
    wb1.Activate
    ws1.Activate
    ws1.Cells.Sort Key1:=ws1.Range("A2"), Order1:=xlDescending, Key2:=ws1.Range("B2"), Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    ws1.Columns("C:F").Insert Shift:=xlToRight
    ws1.Range("C2:C" & ws1.Range("A65000").End(xlUp).Row).Value = "K"
    ws1.Range("D2:D" & ws1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&RC[-2]"
    ws1.Range("E2:E" & ws1.Range("A65000").End(xlUp).Row).Value = "KMART#"
    ws1.Range("F2:F" & ws1.Range("A65000").End(xlUp).Row).Value = "=RC[-1]&" & Chr(34) & " " & Chr(34) & "&RC[-4]"
'The next line is the same as doing a copy and paste values
    ws1.Range("C:F").Formula = ws1.Range("C:F").Value
    ws1.Columns.AutoFit

'Create Extra cartons workbook
    ws3.name = "Extra Cartons"
    ws1.Rows("1:1").Copy ws3.Rows("1:1")
    rws = xlApp.Intersect(rg1, ws1.UsedRange).Rows.Count
   
    While i <= rws
        If IsNumeric(ws1.Cells(i, rg1.Column).Value) Then
            If ws1.Cells(i, rg1.Column).Value > 1 Then
                For x = 1 To ws1.Cells(i, rg1.Column).Value - 1
                    ws1.Rows(i).Copy ws3.Rows(y)
                    y = y + 1
                Next
            End If
        End If
        i = i + 1
    Wend

'Copy info from ws1 to ws2 and format
    wb1.Names.Add name:="SHIPTONAME", RefersToR1C1:= _
        "='STORE INFO'!C4"
    'wb1.Names.Add name:="SHIPTONAME", RefersTo:="='STORE INFO'!C6"
    ws1.Range("SHIPTONAME").Copy ws2.Range("SHIPTONAME")
    ws2.Range("C1").Value = "Ship To Name"
    ws1.Range("ADDRESS1").Copy ws2.Range("ADDRESS1")
    ws1.Range("CITY").Copy ws2.Range("CITY")
    ws1.Range("STATE").Copy ws2.Range("STATE")
    ws1.Range("ZIP").Copy ws2.Range("ZIP")
    ws1.Range("PURCHASEORDER").Copy ws2.Range("PURCHASEORDER")
    ws1.Range("ORDERNUMBER").Copy ws2.Range("ORDERNUMBER")
   
    ws2.Range("B2:B" & ws2.Range("C65000").End(xlUp).Row).Value = strCARRIER
    ws2.Range("D2:D" & ws2.Range("C65000").End(xlUp).Row).Value = "Receiving"
    ws2.Range("L2:L" & ws2.Range("C65000").End(xlUp).Row).Value = strWEIGHT
    ws2.Range("R2:R" & ws2.Range("C65000").End(xlUp).Row).Value = strDEPARTMENT
    ws2.Range("M2:M" & ws2.Range("C65000").End(xlUp).Row).Value = strPAYFLAG
    ws2.Columns.AutoFit

'Delete old file
    strFileName = "\\atlfile1\shared\kewill\KewillBatch.csv"
    If Len(Dir(strFileName)) > 0 Then
        Kill strFileName
    End If

'Save wb2, close wb1
    wb2.SaveAs FileName:=strFileName, FileFormat:=xlCSV
    wb1.Close False
    ws2.Range("A2", xlApp.ActiveCell.SpecialCells(xlLastCell)).Delete Shift:=xlUp

'Name and Format wb3
    wb3.Activate
    ws3.Columns.AutoFit
    ws3.Columns("F:F").Select
    ws3.Names.Add name:="SHIPTONAME", RefersToR1C1:= _
        "='Extra Cartons'!C6"
    ws3.Columns("G:G").Select
    ws3.Names.Add name:="PURCHASEORDER", RefersToR1C1:= _
        "='Extra Cartons'!C7"
    ws3.Columns("A:A").Select
    ws3.Names.Add name:="ORDERNUMBER", RefersToR1C1:= _
        "='Extra Cartons'!C1"
    ws3.Columns("X:X").Select
    ws3.Names.Add name:="CITY", RefersToR1C1:="='Extra Cartons'!C24"
    ws3.Columns("Y:Y").Select
    ws3.Names.Add name:="STATE", RefersToR1C1:= _
        "='Extra Cartons'!C25"
    ws3.Columns("Z:Z").Select
    ws3.Names.Add name:="ZIP", RefersToR1C1:="='Extra Cartons'!C26"
    ws3.Columns("W:W").Select
    ws3.Names.Add name:="ADDRESS1", RefersToR1C1:= _
        "='Extra Cartons'!C23"

'copy back data
    ws3.Range("SHIPTONAME").Copy ws2.Range("SHIPTONAME")
    ws2.Range("C1").Value = "Ship To Name"
    ws3.Range("ADDRESS1").Copy ws2.Range("ADDRESS1")
    ws3.Range("CITY").Copy ws2.Range("CITY")
    ws3.Range("STATE").Copy ws2.Range("STATE")
    ws3.Range("ZIP").Copy ws2.Range("ZIP")
    ws3.Range("PURCHASEORDER").Copy ws2.Range("PURCHASEORDER")
    ws3.Range("ORDERNUMBER").Copy ws2.Range("ORDERNUMBER")

    ws2.Range("B2:B" & ws2.Range("C65000").End(xlUp).Row).Value = strCARRIER
    ws2.Range("D2:D" & ws2.Range("C65000").End(xlUp).Row).Value = "Receiving"
    ws2.Range("L2:L" & ws2.Range("C65000").End(xlUp).Row).Value = strWEIGHT
    ws2.Range("R2:R" & ws2.Range("C65000").End(xlUp).Row).Value = strDEPARTMENT
    ws2.Range("M2:M" & ws2.Range("C65000").End(xlUp).Row).Value = strPAYFLAG
    ws2.Columns.AutoFit

'Delete old file
    strFileName = "\\atlfile1\shared\kewill\KewillBatch2.csv"
    If Len(Dir(strFileName)) > 0 Then
        Kill strFileName
    End If

'Save wb2, close wb2 and wb3
    wb2.SaveAs FileName:=strFileName, FileFormat:=xlCSV
    wb2.Close False
    wb3.Close False
   
    xlApp.Quit
   
    Set rg1 = Nothing
    Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing
    Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
    Set xlApp = Nothing
MsgBox ("Batch Process complete.  You can get the batch file from S:\Kewill\KewillBatch.csv and S:\Kewill\KewillBatch2.csv"), , "Processing Complete"

End Function