asked on

Runtime Error 9 - Subscript out of Range (Check to see if Sheet Exists)

I'm working on an Access Database that has some VBA Code that was written by a fellow employee.

When I run it, it appears to be looking for a specific Worksheet in an Excel Spreadsheet, but that worksheet doesn't exist.

How can I check to see if the sheet exists first, and then continue on with the code if it doesn't exist, or if it does exist, continue on with a different portion of the code.

The error is happening on Line 38.

Below is the code:

Function ExportToExcel(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long
On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim xlApp As Excel.Application
  Dim xlWorkBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
  
  strFilePath = GetWinTempPath & "FracFocusData.xlsx"
  If Dir(strFilePath) <> "" Then Kill strFilePath
  
  If bIsALL = True Then
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_ALL", strFilePath
  Else
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_SEL", strFilePath
    DoCmd.TransferSpreadsheet acExport, , "qry_JL_03", strFilePath
  End If
  
  Set xlApp = New Excel.Application
  Set xlWorkBook = xlApp.Workbooks.Open(strFilePath)
  xlApp.Visible = True
 
  If bIsALL = True Then
    xlApp.Worksheets("qry_FRAC_ACTIVITY_ALL").Name = "FracData"
  Else
    xlApp.Worksheets("qry_FRAC_ACTIVITY_SEL").Name = "FracData"
    xlApp.Worksheets("qry_JL_03").Name = "OnlyOnLeviRpt"
  End If
  
  xlApp.Worksheets(1).select
  ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlSheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
    xlApp.Worksheets("OnlyOnLeviRpt").select
    ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlSheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
  xlApp.Worksheets(1).select
  
ErrHandler:
  Set xlSheet = Nothing
  Set xlWorkBook = Nothing
  Set xlApp = Nothing

  If err.Number = 70 Then 'user probably has it open
    MsgBox "Please Close FracFocusData.xls", vbExclamation, "Unable to Export"
    ExportToExcel = -1
    Exit Function
  End If

  ExportToExcel = ErrorHandler(err, "ExportToExcel")
End Function

Open in new window

Thanks,
gdunn59

Shums Faruk

Hi,

You can try below, changing the sheet name

'Delete Temp Sheet Sheet if exist
Application.DisplayAlerts = False
On Error Resume Next
Sheets("TempSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Open in new window

JesterToo

Or, you could use this from Stackoverflow...

Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet

     If wb Is Nothing Then Set wb = ThisWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

Open in new window

gdunn59

ASKER

Shums,

It's looking for this Sheet:

xlApp.Worksheets("OnlyOnLeviRpt").select

But it doesn't exist at the time. I don't want to delete any sheets.

Thanks,
gdunn59

ASKER CERTIFIED SOLUTION

Roy Cox

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

gdunn59

ASKER

Roy_Cox,

When I tried your posting, I get the following error:

Error: 1004
ExportToExcel
Application-defined or object-defined error

Then if I click on OK, it continues through the code, but then I get this error:

Error: 1004
CombineAndExport
Application-defined or object-defined error

Then if I click on OK, the process finishes.

Here is the code for the Functions ExportToExcel (which is the Code I initially posted) and CombineAndExport

Function ExportToExcel(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long
'  On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim xlApp As Excel.Application
  Dim xlWorkBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
  
  strFilePath = GetWinTempPath & "FracFocusData.xlsx"
  If Dir(strFilePath) <> "" Then Kill strFilePath
  
  If bIsALL = True Then
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_ALL", strFilePath
  Else
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_SEL", strFilePath
    DoCmd.TransferSpreadsheet acExport, , "qry_JL_03", strFilePath
  End If
  
  Set xlApp = New Excel.Application
  Set xlWorkBook = xlApp.Workbooks.Open(strFilePath)
  xlApp.Visible = True
 
  If bIsALL = True Then
    xlApp.Worksheets("qry_FRAC_ACTIVITY_ALL").Name = "FracData"
  Else
    xlApp.Worksheets("qry_FRAC_ACTIVITY_SEL").Name = "FracData"
    xlApp.Worksheets("qry_JL_03").Name = "OnlyOnLeviRpt"
  End If
  
  xlApp.Worksheets(1).select
  ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlSheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
   
    If WksExists("OnlyOnLeviRpt") Then
    
    xlApp.Worksheets("OnlyOnLeviRpt").select
    ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlSheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
  Else
  
    xlApp.Worksheets(1).select
  End If
  
  
ErrHandler:
  Set xlSheet = Nothing
  Set xlWorkBook = Nothing
  Set xlApp = Nothing

  If err.Number = 70 Then 'user probably has it open
    MsgBox "Please Close FracFocusData.xls", vbExclamation, "Unable to Export"
    ExportToExcel = -1
    Exit Function
  End If

  ExportToExcel = ErrorHandler(err, "ExportToExcel")
End Function



Function CombineAndExport(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long
On Error GoTo ErrHandler
  
  DoCmd.SetWarnings False
  'we have to modify the api number from the website since it is not formatted the same as our system
  If bSkipFF = False Then
    DoCmd.RunSQL "UPDATE FRAC_FOCUS_DATA SET FRAC_FOCUS_DATA.API_MOD = Replace([API],'-','');"
    DoCmd.RunSQL "UPDATE FRAC_FOCUS_DATA SET FRAC_FOCUS_DATA.API_MOD = Left([API_MOD],10);"
    DoCmd.RunSQL "UPDATE FRAC_ACTIVITY_SEL INNER JOIN FRAC_FOCUS_DATA ON FRAC_ACTIVITY_SEL.API_NO = FRAC_FOCUS_DATA.API_MOD SET FRAC_ACTIVITY_SEL.IN_FRAC_FOCUS = 1;"
  End If
    
  'MsgBox "Export Stiffled for Now"
  
  CombineAndExport = ExportToExcel(bSkipFF, bIsALL)
  If CombineAndExport <> 0 Then Exit Function

ErrHandler:
  DoCmd.SetWarnings True
  CombineAndExport = ErrorHandler(err, "CombineAndExport")
End Function

Open in new window

Shums Faruk

Please check here It shows how to check if sheet exist while exporting from Access to Excel.

gdunn59

ASKER

Shums,

I looked at your link, but I'm not sure how to go about it.

Any assistance would be greatly appreciated.

Thanks,
gdunn59

gdunn59

ASKER

Roy_Cox,

Your posting does check whether the worksheet is there or not and comes back with False because it is not there, but then I still get that Subscript out of range error.

The error is happening when it starts to run the following line of code:

ExportToExcel = ErrorHandler(err, "ExportToExcel")

Open in new window

This is the error handler code it is running and having issues with:

Function ErrorHandler(err As ErrObject, strFromWhere As String) As Long
'Standard errorhandling function
'  ErrorHandler = err.Number
  If err.Number <> 0 Then
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    MsgBox strFromWhere & vbCrLf & err.Description, vbExclamation, "Error: " & err.Number
  End If
End Function

Open in new window

Thanks,
gdunn

gdunn59

ASKER

Help Please!!!!

Thanks,

gdunn59

Roy Cox

Why is the code looking for a non existent sheet? Which sheet is it supposed to be formatting?

gdunn59

ASKER

Depending on what button is clicked, they both use the same Function, as I referenced in my prior postings. One creates just the one tab, and the other button creates a spreadsheet with 2 tabs, which one of those is the same as the tab in the other spreadsheet.

Thanks,

gdunn59

Roy Cox

I'm not sure what the relevance of the sheet OnlyOnLeviRpt is but this will add the sheet if is misssing

If Not WksExists("OnlyOnLeviRpt") Then
    xlapp.Worksheets.Add
    xlapp.ActiveSheet.Name = "OnlyOnLeviRpt"
End If

xlapp.Worksheets("OnlyOnLeviRpt").Select
ExportToExcel = MakeExcelPretty(xlapp, bSkipFF, bIsALL)
If ExportToExcel <> 0 Then
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlapp = Nothing
    Exit Function
End If

Open in new window

gdunn59

ASKER

Roy_Cox,

The problem isn't that the OnlyOnLeviRpt Sheet is missing, it's that once the Sheet is there, it thinks it isn't and so it skips the line of code that calls the MakeSheetPretty Function, which formats the Sheet.

Thanks,

gdunn59

Roy Cox

I can't see why the code errors if the sheet exists. It's difficult to test properly with the code being in Access but I'll take a closer look at all the code that you have posted and reply later.