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
'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: