Run time error on User Form affecting only 1 user...

[brianv]

I have a excel file (PM Project Log) with a UserForm, used by dozens of people to assist in entering data into our project log spreadsheet. Essentially it for the estimators to login a new project, they enter data onto a UserForm, and the form then unprotects the sheet, finds the last row, enters in 25ish points of data into various columns of the spreadsheet and reprotects the sheet. We chose a UserForm simply for convenience, because some of our users ARE NOT Excel savy by any means...

The issue is, I have one user and only one, that when he "submits" the form, he gets this Run-Time error...

Microsoft Visual Basic

Run-time error '-2147417948 (80010108)':

Automation error
The object invoked has disconnected from its clients.

Sometimes the data he enters on the UserForm get uploaded into the spreadsheet, other times it doesn't, it is inconsistent.

This PM Project Log file also has a 10minute timer on it, so after 10 minutes on inactivity, the file saves and closes: to prevent someone from 'forgetting' they have it opened.

Sub OnTime()
'Application.OnTime Now + TimeValue("00:01:00"), "MyMacro"
Application.OnTime Now + TimeValue("00:10:00"), "CloseMacro"
End Sub

Sub CloseMacro()
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

I thought that this might be causing the problem, but his error message is occurring even if we have the workbook open for 1 minute.

Here is my code for the UserForm:

Private Sub CmdSubmit_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Active")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row

'Range("A65535").End(xlUp).Offset(1, 0).Select

'Unprotect WorkSheet
Sheets("Active").Unprotect "password"

'copy the data to the database
ws.Cells(iRow, 1).Value = "Yes"
ws.Cells(iRow, 2).Value = Me.TextJobNumber.Value
ws.Cells(iRow, 5).Value = Me.ComboPWage.Value
ws.Cells(iRow, 6).Value = Me.TextProjectName.Value
ws.Cells(iRow, 7).Value = Me.TextProjectAddress.Value
ws.Cells(iRow, 8).Value = Me.TextProjectCity.Value
ws.Cells(iRow, 9).Value = Me.TextProjectState.Value
ws.Cells(iRow, 10).Value = Me.TextProjectZip.Value
ws.Cells(iRow, 11).Value = Me.TextCustomer.Value
ws.Cells(iRow, 12).Value = Me.TextSalesman.Value
ws.Cells(iRow, 13).Value = Me.ComboSystemType.Value
ws.Cells(iRow, 14).Value = Me.TextPanelType.Value
ws.Cells(iRow, 15).Value = Me.ComboProjectType.Value
ws.Cells(iRow, 16).Value = Me.ComboInstallType.Value
ws.Cells(iRow, 17).Value = Date
ws.Cells(iRow, 18).Value = Me.ComboPriority.Value
ws.Cells(iRow, 19).Value = Me.TextValue.Value
ws.Cells(iRow, 29).Value = Me.TextDesignHours.Value
ws.Cells(iRow, 30).Value = Me.ComboDesignOT.Value
ws.Cells(iRow, 33).Value = Me.TextSubmittalDate.Value
ws.Cells(iRow, 34).Value = Me.TextDwgDate.Value
ws.Cells(iRow, 70).Value = Me.TextInstallHours.Value
ws.Cells(iRow, 71).Value = Me.ComboInstallOT.Value

'close the New Expense Record Form
Unload Me

Range("A65535").End(xlUp).Offset(1, 0).Select

'Copy 1st Blank Row after Data and Paste/Insert
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

'Reprotect Worksheet
Sheets("Active").Protect "password", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True

End Sub

Private Sub CmdCancel_Click()
 Unload Me
End Sub

Private Sub Label57_Click()

End Sub

Private Sub Label58_Click()

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub Label59_Click()

End Sub

Private Sub TextJobNumber_Change()

End Sub

Private Sub TextProjectName_Change()

End Sub

Private Sub TextSubmittalDate_Change()

End Sub

Private Sub UserForm_Initialize()
Dim cPWage As Range
Dim cSystemType As Range
Dim cProjectType As Range
Dim cInstallType As Range
Dim cPriority As Range
Dim cDesignOT As Range
Dim cInstallOT As Range
Dim ws As Worksheet
Set ws = Worksheets("NameRange")

For Each cPWage In ws.Range("PWage")
  With Me.ComboPWage
    .AddItem cPWage.Value
    .List(.ListCount - 1, 1) = cPWage.Offset(0, 1).Value
  End With
Next cPWage

For Each cSystemType In ws.Range("SystemType")
  With Me.ComboSystemType
    .AddItem cSystemType.Value
    .List(.ListCount - 1, 1) = cSystemType.Offset(0, 1).Value
  End With
Next cSystemType

For Each cProjectType In ws.Range("ProjectType")
  With Me.ComboProjectType
    .AddItem cProjectType.Value
    .List(.ListCount - 1, 1) = cProjectType.Offset(0, 1).Value
  End With
Next cProjectType

For Each cInstallType In ws.Range("InstallType")
  With Me.ComboInstallType
    .AddItem cInstallType.Value
    .List(.ListCount - 1, 1) = cInstallType.Offset(0, 1).Value
  End With
Next cInstallType

For Each cPriority In ws.Range("Priority")
  With Me.ComboPriority
    .AddItem cPriority.Value
    .List(.ListCount - 1, 1) = cPriority.Offset(0, 1).Value
  End With
Next cPriority

For Each cDesignOT In ws.Range("DesignOT")
  With Me.ComboDesignOT
    .AddItem cDesignOT.Value
    .List(.ListCount - 1, 1) = cDesignOT.Offset(0, 1).Value
  End With
Next cDesignOT

For Each cInstallOT In ws.Range("InstallOT")
  With Me.ComboInstallOT
    .AddItem cInstallOT.Value
    .List(.ListCount - 1, 1) = cInstallOT.Offset(0, 1).Value
  End With
Next cInstallOT

End Sub

Ive have verified that his Macro settings are enabled and that his Protected View is turned off, otherwise i have no idea what to look for as to whats causing this.

Because this person doesn't work in the office full-time, i cant verify your suggesting immediately... it may take a day or so to get verify something.

Thanks in advance.

 

[Richard U]

This sounds like a connectivity issue. his VPN or antivirus may be giving the macro a problem.

 

[dmt32]

Just out of interest, If the workbook is closed within your 10 min setting, do you cancel the timer?

If not, you should consider doing something like this:

Standard Module

 Public ScheduleOnTime As Date

Sub OnTime()
ScheduleOnTime = Now + TimeValue("00:10:00")
Application.OnTime ScheduleOnTime, "CloseMacro"
End Sub


Sub CancelOnTime()
    On Error Resume Next
    Application.OnTime EarliestTime:=ScheduleOnTime, Procedure:="CloseMacro", Schedule:=False
    On Error GoTo 0
End Sub

Thisworkbook code page

 Private Sub Workbook_BeforeClose(Cancel As Boolean)    
  CancelOnTime
End Sub

As an alternative suggestion, if all your users have access to your workbook over your corporate network then I personally would provide each user with copy of the workbook & set this to write the data to a central master workbook (database). This way, users can leave their copy open all day long & removes the need for a timer which can prove troublesome for some.

Dave