While using a For Each loop in VBA, the data gets duplicated multiple times - excel

Question

I am trying to upload the data to the destination workbook from the source workbook.
Let's assume I have 15-20 rows of data.
There are two conditions:
When the frmData.txtdate.Value (textbox value from the userform) is = to the destination workbook's cell value, then there will be a MsgBox displaying that the data is already copied. Also I want that if this gets executed then the destination workbook should get closed.
When the frmData.txtdate.Value (textbox value from the userform) is = to the source workbook's cell value , then the whole data from range A2:T999 would get copied and pasted to the destination workbooks range A:Lastrow
But when I try doing it, all the 15-20 rows get duplicated and copied for 15-20 times below each other.
The code is as follows:
Private Sub Upload()
Dim SourceWB As Workbook
Dim SourceWs As Worksheet
Dim DesWB As Workbook
Dim DesWs As Worksheet
Dim DateRange As Range
Dim DesDataRange As Range
Dim LastRowCount As Long 'Upload Button Value
Dim DesLastRow As Long
Dim Ls As Long
Dim Y As Long
Set SourceWB = ThisWorkbook
Set SourceWs = SourceWB.Worksheets("Database")
Set DesWB = ActiveWorkbook
Set DesWs = DesWB.ActiveSheet
LastRowCount = SourceWs.Range("D" & Rows.count).End(xlUp).Row
DesLastRow = DesWs.Range("D" & Rows.count).End(xlUp).Row
Set DateRange = SourceWs.Range("D2", "D" & LastRowCount)
Set DesDateRange = DesWs.Range("D2", "D" & DesLastRow)
'Check Destination File for Similar Date
For Each Cell In DesDateRange
If Cell.Value = frmData.txtdate.Value Then
MsgBox "Data Already Colated, If you want To make any Changes Contact your SME Or Admin"
Exit Sub
End If
Next Cell
'Paste Similar Date Values to destination file
'*The problem starts here*
For Each Cell In DateRange
If Cell.Value = frmData.txtdate.Value Then
'Y = Cell.Row 'Cells(y, 1), Cells(y, 20)
SourceWs.Range("A" & 2, "T" & LastRowCount).Copy
Workbooks(FileNameValue).Activate
Ls = ActiveWorkbook.Worksheets("Sheet1").Range("A" & Rows.count).End(xlUp).Row
ActiveWorkbook.Worksheets("Sheet1").Range("A" & Ls + 1).PasteSpecial Paste:=xlPasteValues 'AndNumberFormats
End If
Next
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Answer 1

In that last for-loop you are:
Going through each cell in a column of SourceWS
For Each Cell In DateRange
Each time copying the whole Source Range
If Cell.Value = frmData.txtdate.Value Then
SourceWs.Range("A" & 2, "T" & LastRowCount).Copy
Workbooks(FileNameValue).Activate
Ls = ActiveWorkbook.Worksheets("Sheet1").Range("A" & Rows.count).End(xlUp).Row
ActiveWorkbook.Worksheets("Sheet1").Range("A" & Ls + 1).PasteSpecial Paste:=xlPasteValues 'AndNumberFormats
End If
Therefore, if more than one cell in DateRange equal the value in txtdate, the whole SourceRange will be copyied (that many times).
So the result you are describing is exactly what is coded.
Now if you want to copy the range only once you have two options:
a) Easiest with the code you have: add an Exit For within right after pasting the range.
b) Best Practice: instead of the For each Cell in DateRange loop, do something like:
Dim rn_found
Set rn_found = DateRange.find(frmData.txtdate.Value)
If Not rn_found Is Nothing Then
'... do your thing
End If