I have put together a VBA that copies from Sheet1 to Sheet2 and sorts by date, and if duplicate exists it stops, but if I add new data to sheet1 it won't copy the new data because it sees the old data first. I need help to expand the current macro to find new data on sheet1 and transpose it to sheet2 and then resort by date each time I click the command button on sheet1. Thank you. This has been a month long process and it's killing me. sheet1 Image and Sheet2 image
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim lastrow2 As Long
Dim FirstCell As Long
Dim lastrow3 As Long
Dim SameCell1 As String
Dim SameCell2 As String
Dim SameCell3 As String
Dim SameCell4 As String
Dim SameCell5 As String
Dim SameCell6 As String
Dim SameCell7 As String
Dim SameCell8 As String
Dim SameCell9 As String
Dim SameCell10 As String
Dim SameCell11 As String
Sheets("sheet2").Activate
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A5:Q21")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lastrow2 = Sheets("sheet2").Range("A" & Rows.Count).End(xlDown).Row
For j = 6 To lastrow2
SameCell4 = Sheets("Sheet2").Range("A" & j).Value
SameCell5 = Sheets("Sheet2").Range("B" & j).Value
SameCell6 = Sheets("Sheet2").Range("C" & j).Value
lastrow = Sheets("sheet1").Range("F" & Rows.Count).End(xlUp).Row + 1
FirstCell = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row
lastrow3 = Sheets("sheet1").Range("f" & Rows.Count).End(xlUp).Row
For i = 3 To lastrow
SameCell1 = Sheets("Sheet1").Range("D" & i).Value
SameCell2 = Sheets("Sheet1").Range("E" & i).Value
SameCell3 = Sheets("Sheet1").Range("F" & i).Value
SameCell7 = Sheets("Sheet2").Range("A" & j).Value
SameCell8 = Sheets("Sheet2").Range("B" & j).Value
SameCell9 = Sheets("Sheet2").Range("C" & j).Value
SameCell10 = Sheets("Sheet2").Range("C" & FirstCell).Value
SameCell11 = Sheets("Sheet1").Range("f" & lastrow3).Value
Sheets("sheet2").Activate
If SameCell1 = "" Then
End
End If
If SameCell6 = SameCell3 And SameCell3 = SameCell6 Then
End
End If
If SameCell1 <> SameCell4 And SameCell3 <> SameCell6 Then
Sheets("sheet1").Activate
Sheets("sheet1").Range(Cells(i, "D"), Cells(i, "F")).Copy
Sheets("sheet2").Activate
Sheets("sheet2").Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A5:Q21")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("sheet1").Activate
End If
Next i
Application.CutCopyMode = False
Next j
End Sub
If SameCell6 = SameCell3 And SameCell3 = SameCell6 Then
doesn't make sense to check that twice, if the first is true then the second must be true too. Don't useEnd
if you meanExit Sub
. End really ends all VBA activity. ButExit Sub
will only exit the current procedure. – Pᴇʜ