Me00550
05-10-2019, 10:02 AM
i have a program that makes a user enter data into cell and if there is nothing in a cell a message box pop up
also in my program i have a close workbook function if open for more than 10 mins, which works as long as the user does not forget to click ok button on the pop message box.
Sub Auto_Open()
Application.OnTime Now + TimeValue("00:10:00"), "CloseMe"
End Sub
Sub CloseMe()
Worksheets("Sheet2").Range("F1").Copy
Worksheets("Final Use").Range("D13").PasteSpecial Paste:=xlPasteValues
Sheets("Final Use").Range("D11").ClearContents
Sheets("QAT USE").Range("C11").ClearContents
Sheets("QAT USE").Range("C13").ClearContents
Sheets("QAT USE").Range("C15").ClearContents
Sheets("QAT USE").Range("C17").ClearContents
Sheets("QAT USE").Range("C19").ClearContents
Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Sub FA_ButtClick()
Set TL = Range("D13")
If IsEmpty(Range("D11").Value) = True Then
MsgBox " Please enter a Serial Number"
Else
If TL.Value = "Select team lead from drop down menu" Then
MsgBox "Please choose a Team Lead from the drop down menu"
Else
Sheets("Log").Unprotect
'Call Call_CopySendRangeFA
Worksheets("Sheet2").Range("F1").Copy
Worksheets("Final Use").Range("D13").PasteSpecial Paste:=xlPasteValues
Sheets("Final Use").Range("D11").ClearContents
Sheets("Log").Protect , _
AllowFiltering:=True
Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.Close
End If
End If
End Sub
also in my program i have a close workbook function if open for more than 10 mins, which works as long as the user does not forget to click ok button on the pop message box.
Sub Auto_Open()
Application.OnTime Now + TimeValue("00:10:00"), "CloseMe"
End Sub
Sub CloseMe()
Worksheets("Sheet2").Range("F1").Copy
Worksheets("Final Use").Range("D13").PasteSpecial Paste:=xlPasteValues
Sheets("Final Use").Range("D11").ClearContents
Sheets("QAT USE").Range("C11").ClearContents
Sheets("QAT USE").Range("C13").ClearContents
Sheets("QAT USE").Range("C15").ClearContents
Sheets("QAT USE").Range("C17").ClearContents
Sheets("QAT USE").Range("C19").ClearContents
Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Sub FA_ButtClick()
Set TL = Range("D13")
If IsEmpty(Range("D11").Value) = True Then
MsgBox " Please enter a Serial Number"
Else
If TL.Value = "Select team lead from drop down menu" Then
MsgBox "Please choose a Team Lead from the drop down menu"
Else
Sheets("Log").Unprotect
'Call Call_CopySendRangeFA
Worksheets("Sheet2").Range("F1").Copy
Worksheets("Final Use").Range("D13").PasteSpecial Paste:=xlPasteValues
Sheets("Final Use").Range("D11").ClearContents
Sheets("Log").Protect , _
AllowFiltering:=True
Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.Close
End If
End If
End Sub