Additional condition to copy only new values

[Neild137]

The following code works fine for me to identify rows of data that have a certain value in Column BH in sheet(SOC 5) and copy the corresponding values in row column A from each respective row, to a new sheet. However, I need to amend the code to copy to my destination sheet ONLY THE Newly Identified values. Meaning, the destination sheet already had some of the values I am looking for. After refreshing my underlying data, I need the code to pull in only, the newest values which meet the criteria. Sub Cond5Copy() 'The data is in sheet Data Sheets("Data").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row For i = 1 To RowCount 'the qualifying value is in column BH Range("BH" & i).Select check_value = ActiveCell If check_value = "5" Then Cells(Application.ActiveCell.Row, 1).Copy 'The destination set is in sheet SOC 5 Sheets("SOC 5").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Range("a" & RowCount + 1).Select ActiveSheet.Paste Sheets("Data").Select End If Next End Sub

<tbody>
</tbody>

 

[Neild137]

Here is the answer:

Sub Cond5CopyNew()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim rowCount As Long

Set wsSource = Worksheets("Data")
Set wsDest = Worksheets("SOC 5")

Application.ScreenUpdating = False
With wsSource
rowCount = .Cells(.Cells.Rows.Count, "a").End(xlUp).Row
For i = 1 To rowCount
If .Cells(i, "BH").Value = 5 Then
'Second check, make sure it's not already copied
'I'm assuming unique value is in col A?
If WorksheetFunction.CountIf(wsDest.Range("A:A"), .Cells(i, "A").Value) = 0 Then
'Copy the row over to next blank row
.Cells(i, "A").Copy wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End If
End If
Next i
End With
Application.ScreenUpdating = True


End Sub