Good afternoon Experts!
One worksheet 1, the user must fill out specific cells (D6, D8, D10, D12, D14, D16, D18, D20, D23, D26, D29). Once all filled out, they can click the ADD NEW button and the content is added to a second worksheet in columns A to K.
- How can I force the user to fill out all 11 cells in order to click the ADD NEW button and move the content to column A to K of worksheet 2? I want all the data fill out, not just a few cells.
- How do I add a code to include the user name and the time / date when entry is added to worksheet 2 (when the button is clicked)? I would like to add it to column L and M of worksheet 2.
Thank you for your help. :sing::sing:
Code
Sub AddNew()
Application.ScreenUpdating = False 'Refresh Smoothness...
'Update data on ((Results)) based on new item entered on ((Entry Sheet))
Dim LProjectName As String
Dim LType As String
Dim LNature As String
Dim LItemName As String
Dim LCategory As String
Dim LStage As String
Dim LProblemSuccess As String
Dim LProblemSuccessDetails As String
Dim LImpact As String
Dim LRecommendation As String
Dim LReference As String
Dim LRow As Long
Dim LFound As Boolean
'Before adding a new item, make sure a value was entered here :
If IsEmpty(Range("D6").Value) = False Then
'Retrieve new information
LProjectName = Range("D6").Value
LType = Range("D8").Value
LNature = Range("D10").Value
LItemName = Range("D12").Value
LCategory = Range("D14").Value
LStage = Range("D16").Value
LProblemSuccess = Range("D18").Value
LProblemSuccessDetails = Range("D20").Value
LImpact = Range("D23").Value
LRecommendation = Range("D26").Value
LReference = Range("D29").Value
'Move to ((Results)) to save the changes
Sheets("Results").Select
LFound = False
LRow = 2
Do While LFound = False
'Encountered a blank project number (assuming end of list on ((Results))
If IsEmpty(Range("A" & LRow).Value) = True Then
LFound = True
End If
LRow = LRow + 1
Loop
Range("A" & LRow - 1).Value = LProjectName
Range("B" & LRow - 1).Value = LType
Range("C" & LRow - 1).Value = LNature
Range("D" & LRow - 1).Value = LItemName
Range("E" & LRow - 1).Value = LCategory
Range("F" & LRow - 1).Value = LStage
Range("G" & LRow - 1).Value = LProblemSuccess
Range("H" & LRow - 1).Value = LProblemSuccessDetails
Range("I" & LRow - 1).Value = LImpact
Range("J" & LRow - 1).Value = LRecommendation
Range("K" & LRow - 1).Value = LReference
'Reposition back on ((Entry Sheet))
Sheets("Entry Sheet").Select
'Clear entries from cells
Range("D6").Value = ""
Range("D8").Value = ""
Range("D10").Value = ""
Range("D12").Value = ""
Range("D14").Value = ""
Range("D16").Value = ""
Range("D18").Value = ""
Range("D20").Value = ""
Range("D23").Value = ""
Range("D26").Value = ""
Range("D29").Value = ""
Range("D6").Select
MsgBox ("Saved")
End If
End Sub
Display More