VBA Code overwrites data

[blueorchid00]

Hi Everyone,I followed a youtube tutorial to copy data from one sheet into another sheet in the same workbook. Mind you, I have no experience in VBA. Everything was working fine until I noticed that when i add a new entry it overwrites the previous row. I want the code to find the last empty row and add the newest entry there. So, if rows 3 and 4 have information, then the newest information gets transferred to row 5 and so forth. Here is the code:

Private Sub CommandButton1_Click()
'Create and set variables for the Time Tracker & Master Data worksheets
Dim TTrk As Worksheet, MDat As Worksheet

Set TTrk = Sheet1
Set MDat = Sheet2

'Create and set variables for each cell in the Time Tracker sheet
Dim Name As Range, AddDate As Range, TotalHours As Range, Activity As Range, Client As Range, Category As Range, AddHours As Range, TimeSpent As Range, Additional As Range

Set Name = TTrk.Range("C2")
Set AddDate = TTrk.Range("C3")
Set TotalHours = TTrk.Range("C5")
Set Activity = TTrk.Range("B8:B15")
Set Client = TTrk.Range("C8:C15")
Set Category = TTrk.Range("D8:D15")
Set AddHours = TTrk.Range("E8:E15")
Set TimeSpent = TTrk.Range("F8:F15")
Set Additional = TTrk.Range("G8:G15")

'Create a variable for the paste cell in the Master Data worksheet
Dim DestCell As Range
If MDat.Range("A2") = "" Then 'If A2 is empty   
Set DestCell = MDat.Range("A2") '...then destination cell is A2
Else   
Set DestCell = MDat.Range("A1").End(xlDown).Offset(1, 0) '...otherwise the next empty row
If MDat.Range("A2") = "" Then 'If A2 is empty   
Set DestCell = MDat.Range("A2") '...then destination cell is A2
Else   
Set DestCell = MDat.Range("A1").End(xlDown).Offset(2, 0) '...otherwise the next empty row   
End If

'Copy and paste data from the Time Tracker worksheet to the Master Data worksheet
Name.Copy DestCell
AddDate.Copy DestCell.Offset(0, 1)
TotalHours.Copy DestCell.Offset(0, 2)
Activity.Copy DestCell.Offset(0, 3)
Client.Copy DestCell.Offset(0, 4)
Category.Copy DestCell.Offset(0, 5)
AddHours.Copy DestCell.Offset(0, 6)
TimeSpent.Copy DestCell.Offset(0, 7)
Additional.Copy DestCell.Offset(0, 8)

'Clear the contents in the Time Tracker worksheet
AddDate.ClearContents
TotalHours.ClearContents
Activity.ClearContents
Client.ClearContents
Category.ClearContents
AddHours.ClearContents
TimeSpent.ClearContents
Additional.ClearContents

End Sub

Thank you so much!

 

[davesexcel]

Set DestCell = MDat.Range("A" & mdat.cells(mdat.rows.count,"A").end(xlup).row + 1 )

 

[blueorchid00]

Set DestCell = MDat.Range("A" & mdat.cells(mdat.rows.count,"A").end(xlup).row + 1 )

Hi Dave, thank you for responding! So sorry to ask, but where in the code should I put this? Thank you!

 

[blueorchid00]

Set DestCell = MDat.Range("A" & mdat.cells(mdat.rows.count,"A").end(xlup).row + 1 )

Hi again, so in my Master Data sheet, if the "Name" and "Date" (Columns A and B) are blank, then if I type information on the Time Tracker sheet and submit it, then data still overwrites the information because there are blanks on columns A and B. I think these columns need to have the name and date to be copied down every time. Can I fix this in my original code? Thanks!

 

[dmt32]

Hi,
I have only glanced at your code but try replacing this part of your code

If MDat.Range("A2") = "" Then 'If A2 is empty
Set DestCell = MDat.Range("A2") '...then destination cell is A2
Else
Set DestCell = MDat.Range("A1").End(xlDown).Offset(1, 0) '...otherwise the next empty row
If MDat.Range("A2") = "" Then 'If A2 is empty
Set DestCell = MDat.Range("A2") '...then destination cell is A2
Else
Set DestCell = MDat.Range("A1").End(xlDown).Offset(2, 0) '...otherwise the next empty row
End If

with this

With MDat
  Set DestCell = .Cells(.Cells(.Rows.Count, "D").End(xlUp).Row + 1, 1)
 End With

and see if this resolves your issue

Dave

 

[blueorchid00]

Hi,
I have only glanced at your code but try replacing this part of your code

If MDat.Range("A2") = "" Then 'If A2 is empty
Set DestCell = MDat.Range("A2") '...then destination cell is A2
Else
Set DestCell = MDat.Range("A1").End(xlDown).Offset(1, 0) '...otherwise the next empty row
If MDat.Range("A2") = "" Then 'If A2 is empty
Set DestCell = MDat.Range("A2") '...then destination cell is A2
Else
Set DestCell = MDat.Range("A1").End(xlDown).Offset(2, 0) '...otherwise the next empty row
End If

with this

With MDat
  Set DestCell = .Cells(.Cells(.Rows.Count, "D").End(xlUp).Row + 1, 1)
 End With

and see if this resolves your issue

Dave

You are a genius and this works! Thank you so much for your time and help

 

[dmt32]

You are a genius and this works! Thank you so much for your time and help

I would not go that far but glad suggestion resolved your issue & appreciate your feedback

Dave