DisplayAlerts Compile Error when running Excel Sub from Access VBA

[mjlex]

I have a module in Access 2010 that exports the results of a select query to excel, opens the .xlsx file, then calls a Sub to distribute the data to multiple worksheets in the excel file and delete the master sheet. Everything works great, except upon deleting the master sheet at the end I receive a 'Data may exist in the sheet(s) selected for deletion. To permanently delete the data, press Delete.' alert. I want to bypass this, however when I add Application.DisplayAlerts = False to my Sub, I receive a Compile error, 'Method or data member not found' on the Excel Sub. I assume this has something to do with the fact that I'm running Access VBA and calling a sub with XL defined as the object, but I am not sure how to alter the code to compensate for this, or if that's possible. My present code is as follows:

<CODE>Function ExportTerminations()
'Code for exporting Query
DoCmd.OutputTo acOutputQuery, "Terms_In_Range", "Excel Workbook(*.xlsx)", _
"I:\HR\DATABASES\PES\PES Reporting\Safe Act\NMLS Responses\Termination Reports\Term Report.xlsx", _
False, "", 0, acExportQualityScreen
Dim XL As Object
Set XL = CreateObject("Excel.Application")
XL.Workbooks.Open "I:\HR\DATABASES\PES\PES Reporting\Safe Act\NMLS Responses\Termination Reports\Term Report.xlsx"
XL.Visible = True

With XL
Call procedure_below
End With
End Function

Excel called from Access Module above:
Sub procedure_below()
Dim WBO As Workbook
Dim ThisWS
Dim rngFilter As Range 'filter range
Dim rngUniques As Range 'Unique Range
Dim cell As Range
Dim counter As Integer
Dim rngResults As Range 'filter range
Set rngFilter = Range("J1", Range("J" & Rows.Count).End(xlUp))
Set rngResults = Range("A1", Range("L" & Rows.Count).End(xlUp))
Application.DisplayAlerts = False
With rngFilter
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUniques = Range("J2", Range("J" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
ActiveSheet.ShowAllData
End With
For Each cell In rngUniques
Worksheets.Add After:=Worksheets(Worksheets.Count)
ThisWS = cell.Value
ActiveSheet.Name = ThisWS
counter = counter + 1
rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
rngFilter.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(ThisWS).Range("A1")
rngResults.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(ThisWS).Range("A1:L1")
Cells.Select
Selection.ColumnWidth = 40.86
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Next cell
rngFilter.Parent.AutoFilterMode = False
Sheets("Terms_In_Range").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub
</CODE>

Can anyone tell me what I'm doing wrong?

Thanks in advance for any help!!

 

[RoryA]

Your title says you are running an Excel sub but it appears your code is in fact all in Access? If so, you need to fully qualify all Excel object references. Something like:

Sub procedure_below(xl As Excel.Application)
   Dim WBO                         As Excel.Workbook
   Dim ThisWS
   Dim rngFilter                   As Excel.Range   'filter range
   Dim rngUniques                  As Excel.Range  'Unique Range
   Dim cell                        As Excel.Range
   Dim counter                     As Integer
   Dim rngResults                  As Excel.Range  'filter range

   Set WBO = xl.ActiveWorkbook
   Set ThisWS = WBO.ActiveSheet

   With WBO.ActiveSheet
      Set rngFilter = .Range("J1", .Range("J" & .Rows.Count).End(xlUp))
      Set rngResults = .Range("A1", .Range("L" & .Rows.Count).End(xlUp))
      xl.DisplayAlerts = False
      With rngFilter
         .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
         Set rngUniques = .Range("J2", .Range("J" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
         .ShowAllData
      End With
   End With
   For Each cell In rngUniques
      WBO.Worksheets.Add After:=WBO.Worksheets(WBO.Worksheets.Count)
      ThisWS = cell.Value
      With WBO.ActiveSheet
         .Name = ThisWS
         counter = counter + 1
         rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
         rngFilter.SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("A1")
         rngResults.SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("A1:L1")
         With .Cells
            .EntireRow.AutoFit
            .EntireColumn.AutoFit
         End With
      End With
   Next cell
   rngFilter.Parent.AutoFilterMode = False
   WBO.Sheets("Terms_In_Range").Delete
   xl.DisplayAlerts = True
End Sub

Then you call it with:

Call procedure_below(XL)

 

[Norie]

Is all this code in Access?

If it is then nothing in procedure_below has no refererence to the Excel instance or workbook in the first sub.

Try this.

Function ExportTerminations()
'Code for exporting Query
    DoCmd.OutputTo acOutputQuery, "Terms_In_Range", "Excel Workbook(*.xlsx)", _
                   "I:\HR\DATABASES\PES\PES Reporting\Safe Act\NMLS Responses\Termination Reports\Term Report.xlsx", _
                   False, "", 0, acExportQualityScreen


    Call procedure_below

End Function


Sub procedure_below()
Dim XL As Object
Dim WBO As Workbook
Dim wsData As Worksheet
Dim ThisWS As Worksheet
Dim rngFilter As Range    'filter range
Dim rngUniques As Range    'Unique Range
Dim cell As Range
Dim counter As Long
Dim rngResults As Range    'filter range

    Set XL = CreateObject("Excel.Application")

    XL.Visible = True

    Set WBO = XL.Workbooks.Open("I:\HR\DATABASES\PES\PES Reporting\Safe Act\NMLS Responses\Termination Reports\Term Report.xlsx")

    Set wsData = WBO.Worksheets("Terms_In_Range")

    With wsData
        Set rngFilter = .Range("J1", .Range("J" & Rows.Count).End(xlUp))
        Set rngResults = .Range("A1", .Range("L" & Rows.Count).End(xlUp))
    End With

    With rngFilter
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        Set rngUniques = wsData.Range("J2", wsData.Range("J" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        ThisWS.ShowAllData
    End With

    For Each cell In rngUniques
        Set ThisWS = WBO.Worksheets.Add(After:=WBO.Worksheets(WBO.Worksheets.Count))

        ThisWS.Name = cell.Value
        counter = counter + 1
        rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
        rngFilter.SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWS.Range("A1")
        rngResults.SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWS.Range("A1:L1")
        With ThisWS
            .UsedRange.EntireColumn.ColumnWidth = 40.86
            .Cells.EntireRow.AutoFit
            .Cells.EntireColumn.AutoFit
        End With

    Next cell

    rngFilter.Parent.AutoFilterMode = False

    XL.DisplayAlerts = False

    wsData.Delete

    XL.DisplayAlerts = True

End Sub

 

[mjlex]

I wasn't able to get Rory's suggestion to work, no matter what I did it was getting hung up on the ThisWS definition. With a little tweaking, however, I was able to get Norie's up and running perfectly. The final code ended up as follows:

<code>Function ExportTest()
'Code for exporting Query
DoCmd.OutputTo acOutputQuery, "Terms_In_Range", "Excel Workbook(*.xlsx)", _
"I:\HR\DATABASES\PES\PES Reporting\Safe Act\NMLS Responses\Termination Reports\Term Report.xlsx", _
False, "", 0, acExportQualityScreen

Call procedure_test
End Function

Sub procedure_test()
Dim XL As Object
Dim WBO As Workbook
Dim wsData As Worksheet
Dim ThisWS As Worksheet
Dim rngFilter As Range 'filter range
Dim rngUniques As Range 'Unique Range
Dim cell As Range
Dim counter As Long
Dim rngResults As Range 'filter range
Set XL = CreateObject("Excel.Application")
XL.Visible = True
Set WBO = XL.Workbooks.Open("I:\HR\DATABASES\PES\PES Reporting\Safe Act\NMLS Responses\Termination Reports\Term Report.xlsx")
Set wsData = WBO.Worksheets("Terms_In_Range")
With wsData
Set rngFilter = .Range("J1", .Range("J" & Rows.Count).End(xlUp))
Set rngResults = .Range("A1", .Range("L" & Rows.Count).End(xlUp))
End With
With rngFilter
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUniques = wsData.Range("J2", wsData.Range("J" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
ActiveSheet.ShowAllData
End With
For Each cell In rngUniques
Set ThisWS = WBO.Worksheets.Add(After:=WBO.Worksheets(WBO.Worksheets.Count))
ThisWS.Name = cell.Value
counter = counter + 1
rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
rngFilter.SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWS.Range("A1")
rngResults.SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWS.Range("A1:L1")
With ThisWS
.UsedRange.EntireColumn.ColumnWidth = 40.86
.Cells.EntireRow.AutoFit
.Cells.EntireColumn.AutoFit
End With
Next cell
rngFilter.Parent.AutoFilterMode = False
XL.DisplayAlerts = False
wsData.Delete
XL.DisplayAlerts = True
End Sub

</code>

Thanks so much for your help! I knew there had to be a way to make Access do my bidding in Excel. Much appreciated!

 

[xenou]

This article explains the importance of using your Excel objects correctly:

Why Excel has a problem when using code in access | BTAB Development