Runtime error '9':Subscript out of range

R

rohanmalhotra

New Member
Joined
May 4, 2010
Messages
29
Hi all

i have created a userform where the data is exported to a database and i am getting the above error everytime a log is entered. Can anyone please help me with it?

HTML: 
Option Explicit
Dim strWorkitem As String
Dim StartTime As Date
Dim Endtime As Date
Dim TimeDiff As Integer
Dim blnDuplicate As Boolean
Dim dTime As Date
Public StartTimer As Long
Dim dHeight As Double
Private Sub butNotes_Click()
    Dim strComments As String
    Dim strExistingString As String
    
    strExistingString = Worksheets("Data").Range("l2")
    strComments = InputBox("Please enter comments", "Comments", strExistingString)
    
    Me.lblNotes.Caption = strComments
    
End Sub
Private Sub butWitem_Click()
    
    Call LockFieldsOne
    Call ReplaceMonth
    Me.txtWorkitem.Value = strWorkitem
    Me.txtStartTime.Value = time
    
End Sub
Private Sub cboActivity_Change()
        Me.txtStartTime.Value = time
        Call LockFieldsThree
    
End Sub

Private Sub cmdClear_Click()
    Me.txtWorkitem.Value = ""
    Me.txtNSM.Value = ""
    Me.cboActivity.Value = ""
    Me.txtStartTime.Value = ""
    Me.txtEndTime.Value = ""
    Me.lblNotes = ""
    Me.optHandoff.Value = ""
    Me.optResolved.Value = ""
    
    Me.txtWorkitem.Locked = False
    Me.txtNSM.Locked = False
    Me.cboActivity.Locked = False
    
End Sub
Private Sub cmdClock_Click()
    Dim StopTime As Date
    StopTime = InputBox("Please enter the stop time", "Stop Time", "")
    Me.txtEndTime.Value = StopTime
End Sub
Private Sub cmdClose_Click()
    Unload Me
    
End Sub
Private Sub cmdSubmit_Click()
    Dim LastRow As Object
    Dim ws As Worksheet
    Dim MyID As Integer
    Dim wb As Workbook
    
    If txtStartTime.Value = "" Then
        MsgBox "Please enter Start Time."
        Exit Sub
        
    ElseIf txtEndTime.Value = "" Then
        MsgBox "Please enter End Time."
        Exit Sub
    End If
    
    
    
    Set wb = Workbooks.Open(Filename:="J:\Test.xls")
    Set ws = wb.Worksheets("Data")
    Set LastRow = ws.Range("a65536").End(xlUp)
    
    LastRow.Offset(1, 0).Value = Me.txtStaffID.Value
    LastRow.Offset(1, 1).Value = Me.txtStaffName.Value
    LastRow.Offset(1, 2).Value = Me.txtDate.Value
    LastRow.Offset(1, 3).Value = Me.txtPCNumber.Value
    LastRow.Offset(1, 4).Value = Me.txtWorkitem.Value
    LastRow.Offset(1, 5).Value = Me.txtNSM.Value
    LastRow.Offset(1, 6).Value = Me.cboActivity.Value
    LastRow.Offset(1, 7).Value = Me.txtStartTime.Value
    LastRow.Offset(1, 8).Value = Me.txtEndTime.Value
    LastRow.Offset(1, 9).Value = Me.txtEntryRef.Value
    LastRow.Offset(1, 10).Value = Me.txtEntryDate.Value
    LastRow.Offset(1, 11).Value = Me.lblNotes.Caption
    LastRow.Offset(1, 12).Value = Me.optResolved.Value
    LastRow.Offset(1, 13).Value = Me.optHandoff.Value
    
    wb.Save
    wb.Close
    
    Call ExportData
    Call SaveData
    Call ADOFromExcelToAccess
    Call BackupData
    
    
    Me.txtWorkitem.Value = ""
    Me.txtNSM.Value = ""
    Me.cboActivity.Value = ""
    Me.txtStartTime.Value = ""
    Me.txtEndTime.Value = ""
    Me.lblNotes = ""
    Me.optHandoff.Value = ""
    Me.optResolved.Value = ""
    
    Me.txtWorkitem.Locked = False
    Me.txtNSM.Locked = False
    Me.cboActivity.Locked = False
    
    
    MsgBox "Log Updated"
    
End Sub
 

Private Sub ToggleButton1_Click()
    If ToggleButton1.Value = True Then
        Me.height = Me.height * 0.1
    Else
    Me.height = dHeight
    End If
End Sub
Private Sub txtDate_Change()
    Dim LDate As String
    LDate = Date
End Sub
Private Sub txtEndTime_Change()
    Me.txtEndTime.Value = Format(Me.txtEndTime, "hh:mm")
End Sub

Private Sub txtEntryDate_Change()
    Dim LDate As String
    LDate = Date
    
End Sub
Private Sub txtNSM_Change()
    
        Me.txtStartTime.Value = time
        Call LockFieldsTwo
    
End Sub
Sub LockFieldsOne()
    If Me.txtWorkitem.Value <> "" Then
        Me.txtNSM.Locked = True
        Me.cboActivity.Locked = True
    End If
    
End Sub
Sub LockFieldsTwo()
        If Me.txtNSM.Value <> "" Then
        Me.txtWorkitem.Locked = True
        Me.cboActivity.Locked = True
    End If
End Sub
Sub LockFieldsThree()
    
    If Me.cboActivity.Value <> "" Then
        Me.txtWorkitem.Locked = True
        Me.txtNSM.Locked = True
    End If
    
End Sub
Private Sub txtStaffID_Change()
    
    Dim FindString As String
    Dim Rng As Range
    
    FindString = Me.txtStaffID.Value
    If Trim(FindString) <> "" Then
        With ThisWorkbook.Worksheets("StaffData").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                        
            If Not Rng Is Nothing Then
            
            Me.txtStaffName.Value = Rng.Offset(0, 1) & " " & Rng.Offset(0, 2)
            
            End If
        End With
    End If
End Sub
Private Sub txtStartTime_Change()
    
    Dim LTime As Integer
    LTime = time
    
    Me.txtStartTime.Value = Format(Me.txtStartTime, "hh:mm")
    
    
End Sub
Private Sub UserForm_Initialize()

Me.txtStaffID.Value = Environ("username")
Me.txtDate.Value = Date
Me.txtDate.Value = Format(Me.txtDate, "dd/mm/yyyy")
Me.txtPCNumber.Value = Environ("computername")
Me.txtEntryDate.Value = Format(Me.txtDate, "dd/mm/yyyy")
Me.txtEntryRef.Value = Environ("username")
dHeight = Me.height
Me.lblTotalMinutes.Caption = Worksheets("Data").Range("p2")
Me.lblWorkitems.Caption = Worksheets("Data").Range("q2")
    With cboActivity
        .AddItem "Acting Manager"
        .AddItem "Approval"
        .AddItem "Authorising Complaint Reopening"
        .AddItem "Batch 5 Day Letters"
        .AddItem "Bulk Mailing"
        .AddItem "Coaching"
        .AddItem "Colleague calls/work"
        .AddItem "Cover (Phones/Identify etc)"
        .AddItem "eGain"
        .AddItem "Holiday"
        .AddItem "Identify"
        .AddItem "Liasing with Third Party"
        .AddItem "Manager Calls"
        .AddItem "Manager Reporting"
        .AddItem "Meeting/1:1"
        .AddItem "Operations"
        .AddItem "Out Of Office"
        .AddItem "Post / Bulk Contract Notes"
        .AddItem "Premium Service Monitoring"
        .AddItem "Project Work"
        .AddItem "Sickness"
        .AddItem "System Down"
        .AddItem "Team Voicemail / Mailbox"
        .AddItem "Testing"
        .AddItem "Training Course"
        .AddItem "Triage"
        .AddItem "Workitem"
    End With
    
End Sub
Sub ReplaceMonth()
    
    Dim strMonth As String
    Dim strMonthNum As String
    Dim intLength As Integer
    
    strWorkitem = Me.txtWorkitem.Value
    intLength = Len(strWorkitem)
    If intLength >= 14 Then
    
        strMonth = UCase(Mid(strWorkitem, 11, 3))
        
        Select Case strMonth
        
            Case "JAN"
                strMonthNum = "01"
            Case "FEB"
                strMonthNum = "02"
            Case "MAR"
                strMonthNum = "03"
            Case "APR"
                strMonthNum = "04"
            Case "MAY"
                strMonthNum = "05"
            Case "JUN"
                strMonthNum = "06"
            Case "JUL"
                strMonthNum = "07"
            Case "AUG"
                strMonthNum = "08"
            Case "SEP"
                strMonthNum = "09"
            Case "OCT"
                strMonthNum = "10"
            Case "NOV"
                strMonthNum = "11"
            Case "DEC"
                strMonthNum = "12"
            Case Else
                strMonthNum = strMonth
            End Select
        Else
    End If
    
    strWorkitem = Trim(WorksheetFunction.Substitute(strWorkitem, strMonth, strMonthNum))
    intLength = Len(strWorkitem)
    
End Sub
Sub SaveData()
    Dim LastRow As Object
    Dim ws As Worksheet
    
    Set ws = Worksheets("Data")
    Set LastRow = ws.Range("a65536").End(xlUp)
    
    LastRow.Offset(1, 0).Value = Me.txtStaffID.Value
    LastRow.Offset(1, 1).Value = Me.txtStaffName.Value
    LastRow.Offset(1, 2).Value = Me.txtDate.Value
    LastRow.Offset(1, 3).Value = Me.txtPCNumber.Value
    LastRow.Offset(1, 4).Value = Me.txtWorkitem.Value
    LastRow.Offset(1, 5).Value = Me.txtNSM.Value
    LastRow.Offset(1, 6).Value = Me.cboActivity.Value
    LastRow.Offset(1, 7).Value = Me.txtStartTime.Value
    LastRow.Offset(1, 8).Value = Me.txtEndTime.Value
    LastRow.Offset(1, 9).Value = Me.txtEntryRef.Value
    LastRow.Offset(1, 10).Value = Me.txtEntryDate.Value
    LastRow.Offset(1, 11).Value = Me.lblNotes.Caption
    LastRow.Offset(1, 12).Value = Me.optResolved.Value
    LastRow.Offset(1, 13).Value = Me.optHandoff.Value
    
    Me.lblTotalMinutes.Caption = Worksheets("Data").Range("p2")
    Me.lblWorkitems.Caption = Worksheets("Data").Range("q2")
    
End Sub
Sub BackupData()
    
    Dim LastRow As Object
    Dim ws As Worksheet
    Dim MyID As Integer
    Dim wb As Workbook
    
    Set wb = Workbooks.Open(Filename:="L:\ISC_Customer Relations\Team Folder\MI\Data.xls")
    Set ws = wb.Worksheets("Data")
    Set LastRow = ws.Range("a65536").End(xlUp)
    
    LastRow.Offset(1, 0).Value = Me.txtStaffID.Value
    LastRow.Offset(1, 1).Value = Me.txtStaffName.Value
    LastRow.Offset(1, 2).Value = Me.txtDate.Value
    LastRow.Offset(1, 3).Value = Me.txtPCNumber.Value
    LastRow.Offset(1, 4).Value = Me.txtWorkitem.Value
    LastRow.Offset(1, 5).Value = Me.txtNSM.Value
    LastRow.Offset(1, 6).Value = Me.cboActivity.Value
    LastRow.Offset(1, 7).Value = Me.txtStartTime.Value
    LastRow.Offset(1, 8).Value = Me.txtEndTime.Value
    LastRow.Offset(1, 9).Value = Me.txtEntryRef.Value
    LastRow.Offset(1, 10).Value = Me.txtEntryDate.Value
    LastRow.Offset(1, 11).Value = Me.lblNotes.Caption
    LastRow.Offset(1, 12).Value = Me.optResolved.Value
    LastRow.Offset(1, 13).Value = Me.optHandoff.Value
    
    wb.Save
    wb.Close
    
End Sub
Private Sub Userform_Activate()
    'Application.OnTime Now + TimeValue("02:00:00"), "CloseForm"
    
End Sub
Sub ExportData()
    
    ThisWorkbook.Worksheets("ExportData").Range("A2") = Me.txtStaffID.Value
    ThisWorkbook.Worksheets("ExportData").Range("B2") = Me.txtStaffName.Value
    ThisWorkbook.Worksheets("ExportData").Range("C2") = Me.txtDate.Value
    ThisWorkbook.Worksheets("ExportData").Range("D2") = Me.txtPCNumber.Value
    ThisWorkbook.Worksheets("ExportData").Range("E2") = Me.txtWorkitem.Value
    ThisWorkbook.Worksheets("ExportData").Range("F2") = Me.txtNSM.Value
    ThisWorkbook.Worksheets("ExportData").Range("G2") = Me.cboActivity.Value
    ThisWorkbook.Worksheets("ExportData").Range("H2") = Me.txtStartTime.Value
    ThisWorkbook.Worksheets("ExportData").Range("I2") = Me.txtEndTime.Value
    ThisWorkbook.Worksheets("ExportData").Range("J2") = Me.txtEntryRef.Value
    ThisWorkbook.Worksheets("ExportData").Range("K2") = Me.txtEntryDate.Value
    ThisWorkbook.Worksheets("ExportData").Range("L2") = Me.lblNotes.Caption
    ThisWorkbook.Worksheets("ExportData").Range("M2") = Me.optResolved.Value
    ThisWorkbook.Worksheets("ExportData").Range("N2") = Me.optHandoff.Value
    
End Sub
 
Sort by date Sort by votes
Did the code used to work and has now stopped working, or has it never worked?

Insert this code immediately after your cn.Open command:-
Code: 
  If cn.State <> 1 Then
    MsgBox "Connection failed"
    Exit Sub
  End If
and try it again. This will tell us whether the connection is failing.
 
Upvote 0

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
You must log in or register to reply here.

Similar threads

C
  • Solved
Runtime Error 9 Subscript Out of Range ... sometmes?
2
Replies
13
Views
319
ColoKevMan
C
Chris_010101
  • Solved
Error 1004
Replies
3
Views
179
Domenic
D
M
  • Solved
run-time error '9' subscript out of range
Replies
1
Views
442
NdNoviceHlp
NdNoviceHlp
S
  • Question
"Subscript out of range ( Run time Error: 09)" Problem in My Excel VBA
Replies
5
Views
247
6StringJazzer
6StringJazzer
Y
  • Question
Help me find error in this coding
Replies
6
Views
366
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,649
Messages
6,120,730
Members
448,987
Latest member
marion_davis

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top