Hi, need help. I have a command button to paste the data to sheet 2 but it's just overwriting the data to row 2.
Codes as follows:
Codes as follows:
Code:
Sub Add_Entry()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim Derick As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
Dim ConfirmAddRecord As Integer
Dim Pogi As PivotTable
ActiveWorkbook.RefreshAll
ConfirmAddRecord = MsgBox("Add Record?", vbYesNo)
'cells to copy from Input sheet - some contain formulas
myCopy = "D4,D7,D9,D11,I5,I7,I9,I11,N5,N7,N9,D14"
Set inputWks = Worksheets("Add Entry")
Set historyWks = Worksheets("Data")
If ConfirmAddRecord = vbYes Then
If inputWks.Range("N7") = "" Then
'MsgBox (ThisWorkbook.Name)
MsgBox ("Enter Date!")
Else
With historyWks
nextRow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End
End With
Set myRng = inputWks.Range(myCopy)
'With inputWks
'Set myRng = inputWks.Range(myCopy)
'If Application.CountA(myRng) <> myRng.Cells.Count Then
'MsgBox "Please fill in all the cells!"
'Exit Sub
'End If
'End With
' With inputWks
' If .Range("c5") = "Not in Roster" Then
' MsgBox "Employee not Available."
' Exit Sub
' End If
' End With
'With inputWks
' If .Range("B12") = "" Then
' MsgBox "Select HR Status!"
' Exit Sub
' End If
' End With
With inputWks
If .Range("D7") = "" Then
MsgBox "Enter Agent Name"
Exit Sub
End If
End With
'With inputWks
' If .Range("b15") = "" Then
' MsgBox "Enter Reason!"
' Exit Sub
' End If
' End With
With historyWks
'With .Cells(nextRow, "A")
'.Value = Now
'.NumberFormat = "mm/dd/yyyy hh:mm:ss"
'End With
'.Cells(nextRow, "B").Value = "Killer"
'.Cells(nextRow, "B").Value = Application.UserName
oCol = 1
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
With inputWks
On Error Resume Next
Application.GoTo .Cells(1) ', Scroll:=True
Range("D7").Select
Selection.ClearContents
Range("D11").Select
Selection.ClearContents
Range("I5").Select
Selection.ClearContents
Range("I7").Select
Selection.ClearContents
Range("I9").Select
Selection.ClearContents
Range("I11").Select
Selection.ClearContents
Range("N5").Select
Selection.ClearContents
Range("D14").Select
Selection.ClearContents
MsgBox ("Record Added and Tracker Cleared.")
ActiveWorkbook.Save
Application.DisplayAlerts = True
ActiveWorkbook.Save
On Error GoTo 0
End With
End If
Else
MsgBox ("Cancelled.")
End If
End Sub
Last edited by a moderator: