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
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
It means one of your sheet names is incorrect or Missing.
Check the spelling of each sheet compared to the actual sheet name.
What line errors out ?
 
Upvote 0
its working fine on my PC. the error only comes when this is used by a different user. Also, if the workbook is closed and re-opened again, it works fine for the first time :(
 
Upvote 0
Which line does execution stop at? Is there a reference in that line to a worksheet? Does the name of the worksheet in the code agree with the actual name of the worksheet?
 
Upvote 0
Apologies as i mentioned the wrong code earlier. Below is the correct code and i am getting error when it comes to .update.

HTML: 
Option Explicit
Dim EntryDateTime As Date
Sub ADOFromExcelToAccess()
    On Error GoTo errTrap
    
    Dim intPK As Integer
    
    EntryDateTime = Now()
    ' exports data from the active worksheet to a table in an Access database
    ' this procedure must be edited before use
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim r As Long
    Dim ws As Worksheet
    ' connect to the Access database
    
    Set cn = New ADODB.Connection
    Set ws = Worksheets("ExportData")
    
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=" & ThisWorkbook.Worksheets("Daily Log").Range("B22") & ";"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "tblDailyLog", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    ' all records in a table
    r = 2 'the start row in the worksheet
    If Len(ws.Range("A" & r).Formula) > 0 Then
    ' repeat until first empty cell in column A
        With rs
        .AddNew
        ' add values to each field in the record
            .Fields("StaffID") = ws.Range("A" & r).Value
            .Fields("StaffName") = ws.Range("B" & r).Value
            .Fields("Date") = ws.Range("C" & r).Value
            .Fields("PCNumber") = ws.Range("D" & r).Value
            .Fields("WorkitemNumber") = ws.Range("E" & r).Value
            .Fields("NSMID") = ws.Range("F" & r).Value
            .Fields("NPA") = ws.Range("G" & r).Value
            .Fields("StartTime") = ws.Range("H" & r).Value
            .Fields("EndTime") = ws.Range("I" & r).Value
            .Fields("EntryRef") = ws.Range("J" & r).Value
            .Fields("EntryDate") = ws.Range("K" & r).Value
            .Fields("Notes") = ws.Range("L" & r).Value
            .Fields("Resolved") = ws.Range("M" & r).Value
            .Fields("HandOff") = ws.Range("N" & r).Value
            .Update
        End With
    End If
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
    Exit Sub
    
errTrap:
    MsgBox "Error performing export" & vbLf & vbLf _
    & Err.Description & vbLf & "Error Number: " & Err.Number & _
    vbLf & vbLf & "Export Cancelled"
End Sub
 
Upvote 0
But Runtime error '9': Subscript out of range - that's still the correct error message, yes?

Does it say Error performing export... Export cancelled?
 
Last edited:
Upvote 0
And it also says Runtime error '9': Subscript out of range?
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
RTE 9 Subscript out of range
Replies
4
Views
63
Peter_SSs
Peter_SSs
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
107
RoryA
RoryA
D
  • Question Question
why show the frame of userform as the photo1
Replies
0
Views
210
david2005wang
D
C
  • Solved
Runtime Error 9 Subscript Out of Range ... sometmes?
2
Replies
13
Views
923
ColoKevMan
C
M
  • Question Question
Sheet code runtime error 1004
Replies
3
Views
189
MeaclH
M

Forum statistics

Threads
1,224,522
Messages
6,179,297
Members
452,903
Latest member
Knuddeluff

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