I am over my head trying to fix a workbook for my employer, which was set up by someone no longer with their company. I am using Excel 2003 and I keep getting a Microsoft Visual Basic message “Run-time error `9` subscript out of range” then I debug and it highlights the 4th line of code in the Extract Module of this 12 sheet workbook.
4th line code as follows: Windows("CCN Dashboard.xls").Activate
The code for this module is below. Can anyone help point me in the right direction?
Thank you for your time and consideration!
Christy
- Code: Select all
Sub ExtractData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.Unprotect
Windows("CCN Dashboard.xls").Activate
Sheets("Front Page").Select
'===================================================================================
'Checks that mandatory Data has been entered.
Range("Date").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Date"
Range("Date").Select
GoTo lastline
End If
Range("Customer").Select
If ActiveCell = "" Then
MsgBox "You Must Enter A Customer Name"
Range("Customer").Select
GoTo lastline
End If
Range("Contact").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Customer Contact"
Range("Contact").Select
GoTo lastline
End If
Range("Email").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Customer Email"
Range("Email").Select
GoTo lastline
End If
Range("QE").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a QE Name"
Range("QE").Select
GoTo lastline
End If
Range("Project").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Project#"
Range("Project").Select
GoTo lastline
End If
Range("Severity").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Severity Class"
Range("Severity").Select
GoTo lastline
End If
If Range("M101") = 0 Then
MsgBox "You Must Enter a Def Quantity"
Range("G15").Select
GoTo lastline
End If
Range("G18").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Problem Description"
Range("G18").Select
GoTo lastline
End If
Range("Lot").Select
If ActiveCell = "" Then
MsgBox "You Must Enter Lot#"
Range("Lot").Select
GoTo lastline
End If
Range("Sort").Select
If ActiveCell = "" Then
MsgBox "Is a SORT Required?"
Range("Sort").Select
GoTo lastline
End If
Range("Visit").Select
If ActiveCell = "" Then
MsgBox "Is an ESC Visit Required?"
Range("Visit").Select
GoTo lastline
End If
Range("Category").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Defect Category"
Range("Category").Select
GoTo lastline
End If
Range("Repeat").Select
If ActiveCell = "" Then
MsgBox "You must enter Yes or No"
Range("Repeat").Select
GoTo lastline
End If
Range("Dept").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Suspect Department"
Range("Dept").Select
GoTo lastline
End If
Range("DetDate").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Detection Date"
Range("DetDate").Select
GoTo lastline
End If
Range("DetPoint").Select
If ActiveCell = "" Then
MsgBox "You Must Enter a Detection Point"
Range("DetPoint").Select
GoTo lastline
End If
'================================================================================
'Opens files
' Test to see if the file is open.
If IsFileOpen("P:\Customer Complaint\CCN Files\Customer Complaint Check List.xls") Then
MsgBox "Another User has the Check List! Please try again later"
Sheets("Front Page").Select
GoTo lastline
Else
Workbooks.Open "P:\Customer Complaint\CCN Files\Customer Complaint Check List.xls", UpdateLinks:=3
'Opens Quality Alert
' Test to see if the file is open.
If IsFileOpen("P:\Customer Complaint\CCN Files\Quality Alert.xls") Then
MsgBox "Another User has the Quality Alert! Please try again later"
Sheets("Front Page").Select
GoTo lastline
Else
Workbooks.Open "P:\Customer Complaint\CCN Files\Quality Alert.xls", UpdateLinks:=3
End If
Programline:
Windows("CCN Dashboard.xls").Activate
Sheets("Front Page").Select
Range("Date").Copy
Sheets("Log").Select
Range("D2:D550").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
Sheets("Front Page").Select
Range("Data").Copy
Sheets("Log").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(rowOffset:=0, columnOffset:=12).Activate
Sheets("Front Page").Select
Range("Data2").Copy
Sheets("Log").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(rowOffset:=0, columnOffset:=-15).Activate
ActiveWorkbook.Save
ActiveCell.Copy
Windows("Customer Complaint Check List.xls").Activate
Sheets("List").Select
Range("Number").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Windows("Quality Alert.xls").Activate
Sheets("Alert").Select
Range("Number").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Windows("CCN Dashboard.xls").Activate
Sheets("Front Page").Select
'AACT Form
'===========================================
If Range("Customer") = "AACT" Then
Application.Run "'CCN Dashboard.xls'!AACTForm.AACTForm"
End If
'Denso Forms
'=======================================================================================
If Range("Customer") = "Denso" Then
Application.Run "'CCN Dashboard.xls'!DensoForms.DensoForms"
End If
'JATCO
'=======================================================================================
If Range("Customer") = "JATCO" Then
Application.Run "'CCN Dashboard.xls'!JATCOForm.JATCOForm"
End If
'NTTechno
'=======================================================================================
If Range("Customer") = "NT Techno" Then
Application.Run "'CCN Dashboard.xls'!NTTechnoForm.NTTechnoForm"
End If
'JTEKT
'=======================================================================================
If Range("Customer") = "JTEKT" Then
Application.Run "'CCN Dashboard.xls'!JTEKTForm.JTEKTForm"
End If
'Hitachi
'=======================================================================================
If Range("Customer") = "Hitachi" Then
Application.Run "'CCN Dashboard.xls'!HitachiForm.HitachiForm"
End If
'INA
'=======================================================================================
If Range("Customer") = "Schaeffler (INA)" Then
Application.Run "'CCN Dashboard.xls'!INAForm.INAForm"
End If
'Tsubaki
'=======================================================================================
If Range("Customer") = "UST" Then
Application.Run "'CCN Dashboard.xls'!TsubakiForm.TsubakiForm"
End If
'Ford and Other
'=======================================================================================
If Range("Customer") = "Ford" Then
Application.Run "'CCN Dashboard.xls'!FordOther.FordOther"
End If
If Range("Customer") = "CFMA" Then
Application.Run "'CCN Dashboard.xls'!FordOther.FordOther"
End If
If Range("Customer") = "CFME" Then
Application.Run "'CCN Dashboard.xls'!FordOther.FordOther"
End If
If Range("Customer") = "Comtech" Then
Application.Run "'CCN Dashboard.xls'!FordOther.FordOther"
End If
If Range("Customer") = "Mazda" Then
Application.Run "'CCN Dashboard.xls'!FordOther.FordOther"
End If
If Range("Customer") = "SPW" Then
Application.Run "'CCN Dashboard.xls'!FordOther.FordOther"
End If
'Other
'=======================================================================================
If Range("Customer") = "GHSP" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "GKN" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "GM" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "Honda" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "Nissan" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "NTN Bearing" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "NTN Driveshaft" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "Oiles" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "OSS" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "Showa" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "Toyota" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
If Range("Customer") = "Unisia" Then
Application.Run "'CCN Dashboard.xls'!Other.Other"
End If
'Clears the CCN Dashboard Fields
Windows("CCN Dashboard.xls").Activate
Sheets("Front Page").Select
Range("Clear1").Select
Selection.ClearContents
Range("Data2").Select
Selection.ClearContents
Range("Clear3").Select
Selection.ClearContents
Range("PartName").Select
Selection.ClearContents
Range("SearchQE").Select
Selection.ClearContents
Range("G7").Select
ActiveWorkbook.Save
lastline:
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'=======================================================================================
MsgBox "Your New CCN Number is," & Chr(13) & " " & Chr(13) & _
" " & Range("CCNNumber").Value & Chr(13) & " " & Chr(13) & _
"You can now open the CCN Form using the next screens!"
'=======================================================================================
'Opens a path to the Currect CCN Folder and allows the user to select the CCN just made
Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim filename As Variant
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path
ChDir ("P:\Customer Complaint\Current CCNs")
With Application
filename = .GetOpenFilename(Filter, FilterIndex, Title)
End With
' Exit on Cancel
If filename = False Then
MsgBox "No file was selected."
Exit Sub
End If
' Open File
Workbooks.Open filename
'========================================
End Sub
