asked on

Access Subscript Out of Range

I'm using the following code to create Excel spreadsheets and I receive an error (subscript out of range) on line Set sht = Wbk.Worksheets("Sheet2"). Thoughts???

Private Sub CreateSpreadsheet(sname As String)
'On Error GoTo Errorhandler
Dim excelApp As Excel.Application
Dim Wbk As Excel.Workbook
Dim sht As Excel.Worksheet
Dim strexcelfile As String
Dim rst As Recordset
Dim db As Database
Dim lastrow As Long
Dim lastcol As Long
Dim ifile As Long
Dim currentrow As Long
Dim strsql As String

strsql = "Select * from [Export " & sname & "]"
Set db = CurrentDb
Set rst = db.OpenRecordset(strsql)
rst.MoveLast
lastrow = rst.RecordCount + 1
rst.MoveFirst
'currentrow = 0
Screen.MousePointer = 11
Set excelApp = CreateObject("Excel.Application")
excelApp.DisplayAlerts = False
excelApp.Visible = True


    Set Wbk = excelApp.Workbooks.Add
    
        Set sht = Wbk.Worksheets("Sheet1")
        sht.Name = sname
        
        sht.Range("A1").Select
        excelApp.ActiveCell = "OMHA Appellant Survey " & sname & " October 1, 2018 - March 31, 2019"
        
        sht.Select
        sht.Range("2:2").Select
    
        For Each fldHeadings In rst.Fields
            excelApp.ActiveCell = fldHeadings.Name
            excelApp.ActiveCell.Offset(0, 1).Select
        Next
                
        'Copy the data to the spreadsheet
        'If currentrow = 0 Then rst.MoveFirst
        sht.Range("A3").CopyFromRecordset rst
        
        'Freeze the first row - headings.
        sht.Range("A3").Select
        excelApp.ActiveWindow.FreezePanes = True
            
        sht.Cells.Select
        With excelApp.Selection
            .WrapText = False
            With .Font
                .Name = "Calibri"
                .Size = 9
            End With
        End With
       sht.Columns("L:S").NumberFormat = "mm/dd/yyyy"
       sht.Columns("AC:AC").NumberFormat = "mm/dd/yyyy"
        excelApp.ActiveSheet.Cells.EntireColumn.AutoFit

    sht.Columns("A:A").ColumnWidth = 12.56
    sht.Columns("B:B").ColumnWidth = 9
    sht.Columns("G:G").ColumnWidth = 30
    sht.Columns("H:H").ColumnWidth = 10
    sht.Columns("I:I").ColumnWidth = 10
    sht.Columns("J:J").ColumnWidth = 10
    sht.Columns("K:K").ColumnWidth = 10
    sht.Columns("L:L").ColumnWidth = 10
    sht.Columns("M:M").ColumnWidth = 10
    sht.Columns("N:N").ColumnWidth = 10
    sht.Columns("O:O").ColumnWidth = 10
    sht.Columns("P:P").ColumnWidth = 10
    sht.Columns("Q:Q").ColumnWidth = 10
    sht.Columns("R:R").ColumnWidth = 10
    sht.Columns("S:S").ColumnWidth = 10
    sht.Columns("AC:AC").ColumnWidth = 10
    sht.Columns("AD:AD").ColumnWidth = 10
    sht.Columns("AE:AE").ColumnWidth = 10
    sht.Columns("AF:AF").ColumnWidth = 30
    sht.Columns("AH:AH").ColumnWidth = 30
    sht.Columns("AI:AI").ColumnWidth = 15
    sht.Columns("AM:AM").ColumnWidth = 10
    sht.Columns("AN:AN").ColumnWidth = 10
    sht.Columns("AO:AO").ColumnWidth = 10
    
    sht.Range("A2:AO2").WrapText = True
      
      
    sht.Range("A2:AO2").Select
    With excelApp.Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 6299648
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With excelApp.Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    excelApp.Selection.Font.Bold = True
    excelApp.Selection.HorizontalAlignment = xlCenter
    
    If sname = "3-Final Sample" Then
        sht.Range("AP2:AP2").Select
        With excelApp.Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 6299648
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        With excelApp.Selection.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        excelApp.Selection.Font.Bold = True
        excelApp.Selection.HorizontalAlignment = xlCenter
    End If
    
    sht.Range("A1").Select
    Set sht = Wbk.Worksheets("Sheet2")
    sht.Delete
    
    Set sht = Wbk.Worksheets("Sheet3")
    sht.Delete
    
    
    'save the workbook
    dbpath = Mid(db.Name, 1, Len(db.Name) - 25)
    
    strexcelfile = dbpath & "\OMHA Appellant Survey " & sname & " Oct 2018-Mar 2019.xlsx"
    If Dir(strexcelfile, vbNormal) <> "" Then Kill strexcelfile
    Wbk.SaveAs strexcelfile
    Wbk.Close


Screen.MousePointer = 0
excelApp.Quit
Set Wbk = Nothing
Set excelApp = Nothing
rst.Close
MsgBox "Done"
Exit Sub

Errorhandler:
    Screen.MousePointer = 0
    MsgBox Err.Description
    Exit Sub

End Sub

Open in new window

Daniel Pineault

Try

Set sht = Wbk.Sheets("Sheet1")

Open in new window

shieldsco

ASKER

That's already in the code

Daniel Pineault

That error occurs when the Sheet you specified does not exist in the Workbook. When you create a new Workbook is there actually a Sheet named 'Sheet1'? Depending on the how you've set things up, the language of your installation it may not. You might be better using the index number instead of the sheet name

Set sht = Wbk.Worksheets(1)

Open in new window

ASKER CERTIFIED SOLUTION

Bill Prew

membership

This solution is only available to members.

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

Start Free Trial

shieldsco

ASKER

Thanks Bill

Daniel Pineault

To add to Bill's comment, I used a function to delete sheets that first validates the sheet actually exists before trying to delete it. The other option is to trap the potential error to avoid issues.

Bill Prew

And if you wanted to be prepared just in case there was more than one sheet you could replace those statements with:

    If Worksheets.Count() > 1 Then
        For i = 2 To Worksheets.Count()
            Wbk.Worksheets(i).Delete
        Next
    End If

Open in new window

»bp