Issue with UserForms code to apply data from the form to Excel file

[brianv]

We have a file for managing our projects and their milestones... a number of months ago i created a UserForm to assist salesman to "upload" a new project into this file. Essentially, it had 24 text or combo boxes, and upon clicking the submit button, it:

1- Verified that each text/combobox was filled in
2- Unprotected the active sheet
3- Copied each of those fields to their respective cells on the next empty row
4- Copy/pasted the next empty row and re-inserted it, to expand the data field
5- Protected the active sheet

Most users have never had any issue, but some users will get an error message when they run the code, its always different, but when they run it again, the code/userform works the 2nd time. Often though, excel will lock up on that user.

Ive got 20 people using this file and 5 salesman using the UserForm to create these new projects, of those 5 salesman, 3 are getting these error messages on a consistent basis.

One if the users gets this message: Run-time error '-2147417878 (80010108)': AUTOMATION ERROR, The object has disconnected from its clients.

Of the 3 users who get error messages, 1 of them is not in the office, he VPNs into the office server. He gets this error message alot.

Of the other 2, an error message yesterday was "g" thats it...

Here is the code:

rivate 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

'check for JobNumber!
If Trim(Me.TextJobNumber.Value) = "" Then
  Me.TextJobNumber.SetFocus
  MsgBox "Please enter a Job Number"
  Exit Sub
End If

'check for PV Wage!
If Trim(Me.ComboPWage.Value) = "" Then
  Me.ComboPWage.SetFocus
  MsgBox "Please select if its Prevailing Wage"
  Exit Sub
End If

'check for Project Name!
If Trim(Me.TextProjectName.Value) = "" Then
  Me.TextProjectName.SetFocus
  MsgBox "Please enter a Project Name"
  Exit Sub
End If

'check for Customer!
If Trim(Me.TextCustomer.Value) = "" Then
  Me.TextCustomer.SetFocus
  MsgBox "Please enter our Customer"
  Exit Sub
End If

'check for Salesman!
If Trim(Me.TextSalesman.Value) = "" Then
  Me.TextSalesman.SetFocus
  MsgBox "Please enter the Salesman"
  Exit Sub
End If

'check for SystemType!
If Trim(Me.ComboSystemType.Value) = "" Then
  Me.ComboSystemType.SetFocus
  MsgBox "Please enter the System Type"
  Exit Sub
End If

'check for PanelType!
If Trim(Me.TextPanelType.Value) = "" Then
  Me.TextPanelType.SetFocus
  MsgBox "Please enter the Panel Type"
  Exit Sub
End If

'check for ProjectType!
If Trim(Me.ComboProjectType.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Verify a the Type of Project"
  Exit Sub
End If

'check for InstallType!
If Trim(Me.ComboInstallType.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Verify the Type of Installation"
  Exit Sub
End If

'check for Priority!
If Trim(Me.ComboPriority.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Verify a Level of Priority"
  Exit Sub
End If

'check for Value!
If Trim(Me.TextValue.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Please enter a Sold Value:"
  Exit Sub
End If

'check for Design Hours!
If Trim(Me.TextDesignHours.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Please enter Design Hours:"
  Exit Sub
End If

'check for Design OT!
If Trim(Me.ComboDesignOT.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Is Design OT Authorized?"
  Exit Sub
End If

'check for Design Hours!
If Trim(Me.TextPMHours.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Is enter PM Hours?"
  Exit Sub
End If

'check for PM OT!
If Trim(Me.ComboPMOT.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Is PM OT Authorized?"
  Exit Sub
End If

'check for Install Hours!
If Trim(Me.TextInstallHours.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Please enter Installation Hours:"
  Exit Sub
End If

'check for Install OT!
If Trim(Me.ComboInstallOT.Value) = "" Then
  Me.TextValue.SetFocus
  MsgBox "Is Installation OT Authorized?"
  Exit Sub
End If

'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, 15).Value = Me.ComboSystemType.Value
ws.Cells(iRow, 16).Value = Me.TextPanelType.Value
ws.Cells(iRow, 17).Value = Me.ComboProjectType.Value
ws.Cells(iRow, 18).Value = Me.ComboInstallType.Value
ws.Cells(iRow, 19).Value = Date
ws.Cells(iRow, 20).Value = Me.ComboPriority.Value
ws.Cells(iRow, 21).Value = Me.TextValue.Value
ws.Cells(iRow, 31).Value = Me.TextDesignHours.Value
ws.Cells(iRow, 32).Value = Me.ComboDesignOT.Value
ws.Cells(iRow, 35).Value = Me.TextSubmittalDate.Value
ws.Cells(iRow, 36).Value = Me.TextDwgDate.Value
ws.Cells(iRow, 73).Value = Me.TextPMHours.Value
ws.Cells(iRow, 74).Value = Me.ComboPMOT.Value
ws.Cells(iRow, 76).Value = Me.TextInstallHours.Value
ws.Cells(iRow, 77).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 ComboBox1_Change()

End Sub

Private Sub Label57_Click()

End Sub

Private Sub Label58_Click()

End Sub

Private Sub Label60_Click()

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub Label59_Click()

End Sub

Private Sub TextCustomer_Change()

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 cPMOT 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 cPMOT In ws.Range("PMOT")
  With Me.ComboPMOT
    .AddItem cPMOT.Value
    .List(.ListCount - 1, 1) = cPMOT.Offset(0, 1).Value
  End With
Next cPMOT

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

Im not sure how to figure out what the actual problem is... so any help is appreciated...

 

[Yongle]

I encountered the same issue years ago
I did not truly get to the bottom of what the real problem was but I succeeded in eliminating it with a clean start

For me, the problem first appeared when a form created on an older version of Excel was run AFTER upgrading from Excel2007 to Excel 2010.
I suspect that some element in the userform was being handled differently by Excel after Excel2007.
This line in your code predates Excel 2007 when the number of rows increased (will not fail, but may give incorrect selection!)

Range("A65535").End(xlUp).Offset(1, 0).Select
[I][COLOR=#006400]it would be better to use..[/COLOR][/I]
Range("A" & Rows.Count).End(xlUp).Offset(1).Select

Your userform seems fairly basic - a few textboxes, labels, a combobox and command button.
I do not get the impression that you are using frames

Suggested solution
- new workbook
- create the userform from scratch

It should take no more than a few minutes to create a workbook containing a test userform with all of the same types of objects
- does not need to look pretty
- test with 5 textboxes not 20 etc
- include the same checks on values etc
- ask everyone to test it

 

[brianv]

When i updated the file, i did create it from scratch about 4 months ago using 2010, including the UserForm, everything was new as we didn't use a UserForm in the previous version of our PM file. However the code i used i copied from an previous 2007 file and pasted into the form.

That being said, ill update that line of code, and see if that corrects anything...

Thanks

 

[Yongle]

Changing that line of code will not fix this problem
Perhaps the workbook has suffered a minor corruption - again a totally clean start would be the best test!

Just a thought - is the workbook set up as a "shared" workbook on OneDrive?

 

[brianv]

No is not setup as shared.

On another note...i am not actually using this line of code to find the last row, as i have a ' in front of it.

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

I am using this sequence shown above it:

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

 

[Yongle]

On another note...i am not actually using this line of code to find the last row, as i have a ' in front of it.

have a look further down the code

'close the New Expense Record Form
Unload Me

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