troubleshooting Question

Access Subscript Out of Range

Avatar of shieldsco
shieldscoFlag for United States of America asked on
Microsoft OfficeMicrosoft AccessMicrosoft Excel
7 Comments1 Solution93 ViewsLast Modified:
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
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 7 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 7 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros