As it only happens when in 'shared' mode I can't debug as it doesn't allow access to the project.
The code executed is below:
Private Sub CmdButNewOK_Click()
Dim SNTDay, SNTMonth, SNTYear, SNTDate As String
Dim SUPERDay, SUPERMonth, SUPERYear, SUPERDate As String
Dim DISPDay, DISPMonth, DISPYear, DISPDate As String
Dim SNTHour, SNTMinute, SNTTime As String
Application.ScreenUpdating = False
'check to see if they picked a ward
If SheetPicked = "" Then
MsgBox "You must select a Ward from the list!"
Exit Sub
End If
'Select worksheet picked and move to the first blank row
ActiveWorkbook.Sheets(SheetPicked).Activate
Range("A1").Select
Do
If IsEmpty(ActiveCell) = False Then 'If there's something in the row..
ActiveCell.Offset(1, 0).Select 'move to the next row
End If
Loop Until IsEmpty(ActiveCell) = True 'Keep doing this until you find the first empty row
ActiveCell.Offset(0, 25) = Range("Control!A90") 'This is the current date and time of the new record
'---------------------------------------------------------------------------------------
'Start getting values from dialog box
'SNT Section
ActiveCell.Value = SheetPicked
'Area label value is automatically input via the Ward drop down code
ActiveCell.Offset(0, 1) = Me.Lbl_AREA
If Me.TB_INTREF.Value > "" Then
ActiveCell.Offset(0, 2) = Me.TB_INTREF.Value
Else
ActiveCell.Offset(0, 2) = "Not Entered"
End If
SNTDay = Combo_DAY.Value
SNTMonth = Combo_MONTH.Value
SNTYear = Combo_YEAR.Value
SNTMinute = ComboMINUTE.Value
SNTHour = ComboHOUR.Value
'Construct date from VARs
SNTDate = SNTDay & "/" & SNTMonth & "/" & SNTYear
ActiveCell.Offset(0, 3) = SNTDate
'Construct time from VARs
SNTTime = SNTHour & ":" & SNTMinute
ActiveCell.Offset(0, 4) = SNTTime
'Information for drop-down comes off the Control Sheet from the named range 'Input_Type'
If Me.ComboINPUTTYPE.Value = "" Then
ActiveCell.Offset(0, 5) = "Not Entered"
Else
ActiveCell.Offset(0, 5) = Me.ComboINPUTTYPE.Value
End If
If Me.Tb_INPUTTYPECOMMENT.Value > "" Then
ActiveCell.Offset(0, 6) = Me.Tb_INPUTTYPECOMMENT.Value
Else
ActiveCell.Offset(0, 6) = "Not Entered"
End If
'Information for drop-down comes off the Control Sheet from the named range 'Input_Type_Summary'
If Me.ComboINPUTTYPESUM.Value = "" Then
ActiveCell.Offset(0, 7) = "Not Entered"
Else
ActiveCell.Offset(0, 7) = Me.ComboINPUTTYPESUM.Value
End If
If Me.Tb_ORIGIN.Value > "" Then
ActiveCell.Offset(0, 8) = Me.Tb_ORIGIN.Value
Else
ActiveCell.Offset(0, 8) = "Not Entered"
End If
'---------------------------------------------------------------------------------------
'Location Section
If Me.Tb_FNAME.Value > "" Then
ActiveCell.Offset(0, 9) = Me.Tb_FNAME.Value
Else
ActiveCell.Offset(0, 9) = "Not Entered"
End If
If Me.Tb_LNAME.Value > "" Then
ActiveCell.Offset(0, 10) = Me.Tb_LNAME.Value
Else
ActiveCell.Offset(0, 10) = "Not Entered"
End If
If Me.Tb_ADDRESS.Value > "" Then
ActiveCell.Offset(0, 11) = Me.Tb_ADDRESS.Value
Else
ActiveCell.Offset(0, 11) = "Not Entered"
End If
If Me.Tb_PHONE.Value > "" Then
ActiveCell.Offset(0, 12) = Me.Tb_PHONE.Value
Else
ActiveCell.Offset(0, 12) = "Not Entered"
End If
If Me.Tb_EMAIL > "" Then
ActiveCell.Offset(0, 13) = Me.Tb_EMAIL
Else
ActiveCell.Offset(0, 13) = "Not Entered"
End If
If Me.Tb_MESSAGE > "" Then
ActiveCell.Offset(0, 14) = Me.Tb_MESSAGE
Else
ActiveCell.Offset(0, 14) = "Not Entered"
End If
'---------------------------------------------------------------------------------------
'Supervision Section
If Me.Tb_SUPER.Value > "" Then
ActiveCell.Offset(0, 15) = Me.Tb_SUPER.Value
Else
ActiveCell.Offset(0, 15) = "Not Entered"
End If
If Me.Tb_ACTION.Value > "" Then
ActiveCell.Offset(0, 16) = Me.Tb_ACTION.Value
Else
ActiveCell.Offset(0, 16) = "Not Entered"
End If
'Get supervision date
SUPERDay = Combo_DD.Value
SUPERMonth = ComboMM.Value
SUPERYear = ComboYYYY.Value
'Construct date for record
SUPERDate = SUPERDay & "/" & SUPERMonth & "/" & SUPERYear
ActiveCell.Offset(0, 17) = SUPERDate
If Me.Tb_OFFICER.Value > "" Then
ActiveCell.Offset(0, 18) = Me.Tb_OFFICER.Value
Else
ActiveCell.Offset(0, 18) = "Not Entered"
End If
'---------------------------------------------------------------------------------------
'Disposal Section
'Column Q
If Me.Tb_DISPREF.Value > "" Then
ActiveCell.Offset(0, 19) = Me.Tb_DISPREF.Value
Else
ActiveCell.Offset(0, 19) = "Not Entered"
End If
'Column R
If Chk_APPROVE = True Then
ActiveCell.Offset(0, 20) = "Y"
Else
ActiveCell.Offset(0, 20) = "Not Entered"
End If
'Column S
If Chk_DISPOSAL = True Then
ActiveCell.Offset(0, 21) = "Y"
Else
ActiveCell.Offset(0, 21) = "Not Entered"
End If
'Disposal date
DISPDay = ComboDISPDAY.Value
DISPMonth = ComboDISPMONTH.Value
DISPYear = ComboDISPYEAR.Value
'Construct disposal date for record
DISPDate = DISPDay & "/" & DISPMonth & "/" & DISPYear
If Chk_DISPOSAL = True Then
ActiveCell.Offset(0, 22) = DISPDate
Else
ActiveCell.Offset(0, 22) = "Not Entered"
End If
'---------------------------------------------------------------------------------------
'Notes Section
If Me.Tb_NOTES.Value > "" Then
ActiveCell.Offset(0, 23) = Me.Tb_NOTES.Value
Else
ActiveCell.Offset(0, 23) = "Not Entered"
End If
ActiveCell.Offset(0, 24) = Me.Tb_OFFICER.Value 'This is the logged on user entering the new record
'Copies the unique reference formula into this record
Range("AB2:AF2").Select
Selection.Copy
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Copy the conditional format to this row
Range("A2:U2").Select
Selection.Copy
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Sheets("Start").Activate
Application.ScreenUpdating = True
Unload Me
End Sub