Cant find the error

chris9104

Board Regular
Joined
Feb 7, 2009
Messages
55
Hi all, I have the below code which fails with an
'application-defined or object-defined error' but it then doesn't highlight the relevant part that is failing. I think i've narrowed it down using break points but still cant see what the problem is. I think the error is occuring somewhere within the highlight section, it is me that highlighted it, nothing is autoamtically highlighted in vba. Any help is appreciated

Private Sub cmdupdate_Click()
Dim lRow As Long
Dim Rowcount As Long
Dim Answer As String
Dim MyNote As String
Dim thesheet As String

Application.ScreenUpdating = False

ActiveWorkbook.Unprotect
ActiveSheet.Unprotect

'Check Name Box is Entered.
If Me.txtnewname.Value = "" Then
MsgBox "Please enter a Name.", vbExclamation, "Error"
Me.txtnewname.SetFocus
Exit Sub
End If
'Check Staff Number is Entered.
If Me.txtnewstaffno.Value = "" Then
MsgBox "Please enter a Staff Number.", vbExclamation, "Error"
Me.txtstaffno.SetFocus
Exit Sub
End If
'Check Hours Box is Entered
If Me.txthours.Value = "" Then
MsgBox "Please enter the Hours Worked per Week.", vbExclamation, "Error"
Me.txthours.SetFocus
Exit Sub
End If
'Check Filter ID is Entered
If Me.txtfilterid.Value = "" Then
MsgBox "Please enter the Filter ID.", vbExclamation, "Error"
Me.txtfilterid.SetFocus
Exit Sub
End If
'Check RACF ID is Entered
If Me.txtracfid.Value = "" Then
MsgBox "Please enter the Filter ID.", vbExclamation, "Error"
Me.txtfilterid.SetFocus
Exit Sub
End If
'Check Target Box is Entered As a Number
If Not IsNumeric(Me.txttarget.Value) Then
MsgBox "Please correct the Target Productivity.", vbExclamation, "Error"
Me.txttarget.SetFocus
Exit Sub
End If

'Confirm you want to proceed
MyNote = "Are you sure you want to update this record? Any data you have entered for this week will be lost for this person!"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Update Record?")
If Answer = vbYes Then

'Set Ranges
ActiveWorkbook.Names.Add Name:="Extension", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C6:R2C7,0,0,COUNTA('Staff Data'!C6)-1)"

ActiveWorkbook.Names.Add Name:="Names", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C2,0,0,COUNTA('Staff Data'!C2)-1)"

ActiveWorkbook.Names.Add Name:="Staff", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C2:R2C19,0,0,COUNTA('Staff Data'!C2)-1)"

ActiveWorkbook.Names.Add Name:="StaffNumbers", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C1,0,0,COUNTA('Staff Data'!C1)-1)"

'Delete Sheet
thesheet = cboname.Value
Application.DisplayAlerts = False
Worksheets(thesheet).Delete
Application.DisplayAlerts = True
'Delete Staff Record
For lRow = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1

If Cells(lRow, "A").Value = txtstaffno.Value Then
Cells(lRow, "A").EntireRow.Delete
End If

Next lRow


'Enter Data to Spreadsheet
Rowcount = Worksheets("Staff Data").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Staff Data").Range("A1")
.Offset(Rowcount, 0).Value = Me.txtnewstaffno.Value
.Offset(Rowcount, 1).Value = Me.txtnewname.Value
.Offset(Rowcount, 2).Value = Me.txtnewstaffno.Value
.Offset(Rowcount, 3).Value = Me.txtracfid.Value
.Offset(Rowcount, 4).Value = Me.txtfilterid.Value
.Offset(Rowcount, 5).Value = Me.txtworks.Value
.Offset(Rowcount, 6).Value = Me.txtwork.Value
If optfull = True Then
.Offset(Rowcount, 7).Value = "Full-Time"
End If
If optpart = True Then
.Offset(Rowcount, 7).Value = "Part-Time"
End If
If opttemp = True Then
.Offset(Rowcount, 7).Value = "Temp"
End If
.Offset(Rowcount, 8).Value = Me.txthours.Value
.Offset(Rowcount, 9).Value = Me.txthome.Value
.Offset(Rowcount, 10).Value = Me.txtmob.Value
.Offset(Rowcount, 11).Value = Me.txttarget.Value / 100
If Me.chkactionplan.Value = True Then
.Offset(Rowcount, 12).Value = "Yes"
Else
.Offset(Rowcount, 12).Value = ""
End If
.Offset(Rowcount, 13).Value = Me.txtactionplan.Value
.Offset(Rowcount, 14).Value = Me.txtemname.Value
.Offset(Rowcount, 15).Value = Me.txtemhome.Value
.Offset(Rowcount, 16).Value = Me.txtemmob.Value
.Offset(Rowcount, 17).Value = Me.txtemwork.Value
End With
'Create New Sheet
Sheets("Control Sheet").Visible = True
Sheets("Control Sheet").Copy Before:=Sheets(3)
Sheets("Control Sheet (2)").Select
With Worksheets("Control Sheet (2)").Range("A1")
Range("A1").Value = Me.txtnewname.Value
Sheets("Control Sheet (2)").Name = Range("A1").Value
Range("A1").Select
End With
Unload Me
Sheets("Control Sheet").Visible = False
'Add Grid Lines
Sheets("Staff Data").Select
Rowcount = Worksheets("Staff Data").Range("A1").CurrentRegion.Rows.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'Set Ranges
ActiveWorkbook.Names.Add Name:="Extension", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C6:R2C7,0,0,COUNTA('Staff Data'!C6)-1)"

ActiveWorkbook.Names.Add Name:="Names", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C2,0,0,COUNTA('Staff Data'!C2)-1)"

ActiveWorkbook.Names.Add Name:="Staff", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C2:R2C19,0,0,COUNTA('Staff Data'!C2)-1)"

ActiveWorkbook.Names.Add Name:="StaffNumbers", RefersToR1C1:= _
"=OFFSET('Staff Data'!R2C1,0,0,COUNTA('Staff Data'!C1)-1)"

Range("Extension").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
Application.ScreenUpdating = False
Sheets("Staff Data").Range("A1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True
ActiveWorkbook.Protect Structure:=True, Windows:=Fals
End If
End Sub
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Is there actually an underscore here?
Rich (BB code):
Rowcount = Worksheets("Staff Data").Range_("A1").CurrentRegion.Rows.Count
 
Upvote 0
its definitely something within:

'Enter Data to Spreadsheet
Rowcount = Worksheets("Staff Data").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Staff Data").Range("A1")
.Offset(Rowcount, 0).Value = Me.txtnewstaffno.Value
.Offset(Rowcount, 1).Value = Me.txtnewname.Value
.Offset(Rowcount, 2).Value = Me.txtnewstaffno.Value
.Offset(Rowcount, 3).Value = Me.txtracfid.Value
.Offset(Rowcount, 4).Value = Me.txtfilterid.Value
.Offset(Rowcount, 5).Value = Me.txtworks.Value
.Offset(Rowcount, 6).Value = Me.txtwork.Value
If optfull = True Then
.Offset(Rowcount, 7).Value = "Full-Time"
End If
If optpart = True Then
.Offset(Rowcount, 7).Value = "Part-Time"
End If
If opttemp = True Then
.Offset(Rowcount, 7).Value = "Temp"
End If
.Offset(Rowcount, 8).Value = Me.txthours.Value
.Offset(Rowcount, 9).Value = Me.txthome.Value
.Offset(Rowcount, 10).Value = Me.txtmob.Value
.Offset(Rowcount, 11).Value = Me.txttarget.Value / 100
If Me.chkactionplan.Value = True Then
.Offset(Rowcount, 12).Value = "Yes"
Else
.Offset(Rowcount, 12).Value = ""
End If
.Offset(Rowcount, 13).Value = Me.txtactionplan.Value
.Offset(Rowcount, 14).Value = Me.txtemname.Value
.Offset(Rowcount, 15).Value = Me.txtemhome.Value
.Offset(Rowcount, 16).Value = Me.txtemmob.Value
.Offset(Rowcount, 17).Value = Me.txtemwork.Value
End With
'Create New Sheet
Sheets("Control Sheet").Visible = True
Sheets("Control Sheet").Copy Before:=Sheets(3)
Sheets("Control Sheet (2)").Select
ActiveSheet.Unprotect
With Worksheets("Control Sheet (2)").Range("A1")
.Value = Me.txtnewname.Value
Sheets("Control Sheet (2)").Name = .Value
.Range("A1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Sheets("Control Sheet").Visible = False
End With
Unload Me

The data is not being pasted correctly onto "Staff Data" but it is then creating the new sheet but not pasting the value into "A1". The same section of code seems to work fine from another userform so I cant find the problem. Please help!
 
Upvote 0
What exactly do you mean by "The data is not being pasted correctly onto 'Staff Data'"? Is the wrong data being pasted; no data being pasted; the right data being pasted but in the wrong place; or something else?
 
Upvote 0
If optfull = True Then
.Offset(Rowcount, 7).Value = "Full-Time"
End If
If optpart = True Then
.Offset(Rowcount, 7).Value = "Part-Time"
End If
If opttemp = True Then
.Offset(Rowcount, 7).Value = "Temp"
End If

is the only part that that is being pasted correctly.

Offset(Rowcount, 11).Value = Me.txttarget.Value / 100

is producing 0 instead of whatever value I enter.

The rest of the target cells are empty
 
Upvote 0
Have you tried stepping through the code to check that the values are what you think they should be at each stage?
For future reference, if you really want people to read through code of that length, you have to use the code tags on the board. Prefix the code with [ code ] (without the spaces) and terminate it with [ /code ] (again, without the spaces). It makes our lives much easier.
 
Upvote 0
Thanks for the tip about displaying the code and sorry for doing it how it was. I've stepped through the code but can only narrow it down to the same section as before, it wont let me go through line by line when it gets to: 'Enter Data to Spreadsheet

Would it be any use if I could send you the file?

Code:
'Enter Data to Spreadsheet
Rowcount = Worksheets("Staff Data").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Staff Data").Range("A1")
.Offset(Rowcount, 0).Value = Me.txtnewstaffno.Value
.Offset(Rowcount, 1).Value = Me.txtnewname.Value
.Offset(Rowcount, 2).Value = Me.txtnewstaffno.Value
.Offset(Rowcount, 3).Value = Me.txtracfid.Value
.Offset(Rowcount, 4).Value = Me.txtfilterid.Value
.Offset(Rowcount, 5).Value = Me.txtworks.Value
.Offset(Rowcount, 6).Value = Me.txtwork.Value
If optfull = True Then
    .Offset(Rowcount, 7).Value = "Full-Time"
End If
If optpart = True Then
   .Offset(Rowcount, 7).Value = "Part-Time"
End If
If opttemp = True Then
    .Offset(Rowcount, 7).Value = "Temp"
End If
.Offset(Rowcount, 8).Value = Me.txthours.Value
.Offset(Rowcount, 9).Value = Me.txthome.Value
.Offset(Rowcount, 10).Value = Me.txtmob.Value
.Offset(Rowcount, 11).Value = Me.txttarget.Value / 100
If Me.chkactionplan.Value = True Then
.Offset(Rowcount, 12).Value = "Yes"
Else
.Offset(Rowcount, 12).Value = ""
End If
.Offset(Rowcount, 13).Value = Me.txtactionplan.Value
.Offset(Rowcount, 14).Value = Me.txtemname.Value
.Offset(Rowcount, 15).Value = Me.txtemhome.Value
.Offset(Rowcount, 16).Value = Me.txtemmob.Value
.Offset(Rowcount, 17).Value = Me.txtemwork.Value
End With
'Create New Sheet
Sheets("Control Sheet").Visible = True
Sheets("Control Sheet").Copy Before:=Sheets(3)
Sheets("Control Sheet (2)").Select
ActiveSheet.Unprotect
With Worksheets("Control Sheet (2)").Range("A1")
    .Value = Me.txtnewname.Value
    Sheets("Control Sheet (2)").Name = .Value
 
Upvote 0
It would probably help at this point - I will PM you an email address shortly, but I can't look at it until tonight.
What do you mean by "it wont let me go through line by line " - what happens exactly?
 
Upvote 0
Thanks, that would be great. It tells me that it cant enter break mode at this time and gives me the option to either end or continue in which case it continues all the way to the end of the sub
 
Upvote 0

Forum statistics

Threads
1,213,514
Messages
6,114,078
Members
448,547
Latest member
arndtea

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