Subscript out of range

[azizrasul]

I get an error in the following code when I try to copy over the sheet "Instructions" in another opened workbook which I can see but does not appear in the list of opened workbooks when I try copy over hence the error message. See line beginning with 'ERRORS HERE to see the problem.

    With Me
        Select Case cboAction.Column(0)
            Case "SPLIT"
                strFolder = Left(.txtInputFile, InStrRev(.txtInputFile, "\"))
                strFilename = Right(.txtInputFile, Len(.txtInputFile) - InStrRev(.txtInputFile, "\"))
                strNewWorksheet = "Temp"
                strWorksheet = .cboWorksheets.Column(3)
                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tblCOD", Me.txtInputFile, , strWorksheet & "!"
                CurrentDb.Execute "DELETE tblCOD.F2 FROM tblCOD WHERE (((tblCOD.F2)='Staff Member')) OR (((tblCOD.F2) Is Null));"
                strSQL = "SELECT tblCOD.F9 INTO tblAreaCodes FROM tblCOD GROUP BY tblCOD.F9 HAVING (((tblCOD.F9)<>'Area name')) ORDER BY tblCOD.F9;"
                Call CreateActionQuery("qryTemp", strSQL, True)
                intRows = DCount("[F2]", "tblCOD") + 1
                CurrentDb.Execute "SELECT tblCOD.F1, tblCOD.F2, tblCOD.F9 INTO tblTemp FROM tblCOD;"
                y = DCount("[F2]", "tblTemp")
                x = 1
                Set rst = CurrentDb.OpenRecordset("tblTemp", dbOpenDynaset)
                
                Do While Not rst.EOF
                    rst.Edit
                    rst!f1 = x
                    rst.Update
                    x = x + 1
                    rst.MoveNext
                Loop
                
                rst.Close
                Set rst = Nothing
                
                Set objExcelAppOriginal = New Excel.Application
                Set rst = CurrentDb.OpenRecordset("tblAreaCodes", dbOpenDynaset)
                
                With objExcelAppOriginal
                    .Workbooks.Open FileName:=Me.txtInputFile, ReadOnly:=blnReadOnly
                    .Visible = True
                End With
                
                Do While Not rst.EOF
                    With objExcelAppOriginal
                        strFilter = rst!F9
                        .ActiveSheet.Range("$A$1:$BC$" & intRows).AutoFilter Field:=9, Criteria1:=strFilter
                        z = DLast("[F1]", "tblTemp", "[F9]='" & strFilter & "'") + 3
                        .Columns("J:P").Select
                        .Selection.EntireColumn.Hidden = False
                        .Range("A1").Select
                        .Rows("1:" & z).Select
                        .Range("A" & z).Activate
                        .Selection.Copy
                        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = strNewWorksheet
                        .ActiveSheet.Paste
                        .Range("A1").Select
                        .Sheets(Me.cboWorksheets.Column(3)).Select
                        .Range("A1").Select
                        .Application.CutCopyMode = False
                        .ActiveSheet.Range("$A$3:$BC$" & intRows).AutoFilter Field:=9
                        
                        strNewFilenameSpecific = Left(Right(Me.txtInputFile, Len(Me.txtInputFile) - InStrRev(Me.txtInputFile, "\")), InStrRev(Right(Me.txtInputFile, Len(Me.txtInputFile) - InStrRev(Me.txtInputFile, "\")), ".") - 1) & " - " & rst!F9 & ".xlsx"
                        strNewFilename = Me.txtSplitFolder & strNewFilenameSpecific
                        
                        If KillFile2(strNewFilename, True, False) = False Then
                            Exit Sub
                        End If
                        
                        .Workbooks.Add
                        .ActiveWorkbook.SaveAs FileName:=strNewFilename
                        .ActiveWorkbook.Close
                        
                        Set objExcelAppNew = New Excel.Application

                        objExcelAppNew.Workbooks.Open FileName:=strNewFilename, IgnoreReadOnlyRecommended:=True
                        objExcelAppNew.Visible = True
                        
                        .Windows(strFilename).Activate
'ERRORS HERE            .Sheets("Instructions").Copy After:=Workbooks(strNewFilenameSpecific).Sheets("Sheet1") 'ERRORS HERE
                        
                        .Windows(strFilename).Activate
                        .Sheets(strNewWorksheet).Select
                        .Sheets(strNewWorksheet).Copy After:=Workbooks(strNewFilenameSpecific).Sheets("Instructions")
                        
                        .Windows(strNewFilenameSpecific).Activate
                        .Sheets(strNewWorksheet).Name = strWorksheet
                        
                        Workbooks(strNewFilenameSpecific).Activate

                        objExcelAppNew.Sheets("Sheet1").Select
                        objExcelAppNew.Sheets("Sheet1").Delete
                        objExcelAppNew.Sheets(strWorksheet).Select
                        objExcelAppNew.Columns("A:I").Select
                        objExcelAppNew.Columns("A:I").EntireColumn.AutoFit
                        objExcelAppNew.Rows("1:1").EntireRow.AutoFit
                        objExcelAppNew.Rows("1:1").RowHeight = 13.5
                        objExcelAppNew.Range("A1").Select
                        
                        .ActiveWorkbook.Save
                        .ActiveWindow.Close

                        Set objExcelAppNew = Nothing
                        
                        .Windows(strFilename).Activate
                        .Sheets(strNewWorksheet).Select
                        .DisplayAlerts = False
                        ActiveWindow.SelectedSheets.Delete
                        .DisplayAlerts = True

                       .ActiveWorkbook.Save
                        .Windows(strFilename).Activate
                    End With
                    rst.MoveNext
                Loop
                
                objExcelAppNew.Quit
                Set objExcelAppNew = Nothing
                
                objExcelAppOriginal.Quit
                Set objExcelAppOriginal = Nothing
        End Select
    End With

 

[baitmaster]

I was going to say that your issue sounds like you have 2 instances of Excel open. Then I saw you have created a new instance using [Set objExcelAppNew = New Excel.Application]. Is this necessary? Why can't you just work with multiple files in one instance of Excel rather than have 2 applications open?

 

[azizrasul]

I will look into that. Thanks.

 

[xenou]

I would also try to avoid working with so many select statements as they aren't really necessary.

Rather than using windows(xxx).activate you can use a workbook reference:

In Excel like this:

dim wb1 as Workbook '//Or dim wb1 as Object
dim wb2 as Workbook '//Or dim wb2 as Object

set wb1 = Workbooks.Open "MyWorkbook1.xlsx"
set wb2 = Workbooks.Open "MyWorkbook2.xlsx"

wb1.Sheets("Instructions").Range("A1").Value = 1.31459
wb2.Sheets("Instructions").Range("A1").Value = 2.71828

wb1.Save
wb1.Close False

wb2.Save
wb2.Close False

and in general that will mean you can use your workbook in code with confidence and not have to activate windows to find it.