Additional condition to copy only new values - excel

Question

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

Answer 1

You can try of moving all data that meets:
Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long
Set s = Sheets("Data") 's for Source
Set d = Sheets("SOC 5") 'd for Destination
LRs = s.Cells( s.Rows.Count, "A").End(xlUp).Row 'last row of source
For i = 1 to LRs
If s.Cells( i, "BH") = 5 Then
LRd = d.Cells( d.Rows.Count, "A").End(xlUp).Row 'last row of destination
s.Rows(i).Copy d.Rows(LRd + 1)
End If
Next i
You can use this to verify newest data:
Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long
Set s = Sheets("Data") 's for Source
Set d = Sheets("SOC 5") 'd for Destination
LRs = s.Cells( s.Rows.Count, "A").End(xlUp).Row 'last row of source
LRd = d.Cells( d.Rows.Count, "A").End(xlUp).Row 'last row of destination
For i = 1 to LRd
If d.Cells( i, "B") = Application.Index( s.Range( s.Cells(1, "B"), s.Cells(LRs, "B")), Application.Match(d.Cells( i, "A"), s.Range( s.Cells(1, "A"), s.Cells(LRs, "A")),0)) Then
s.Rows(Application.Match(d.Cells( i, "A"), s.Range( s.Cells(1, "A"), s.Cells(LRs, "A")),0)).Copy d.Rows(i)
End If
Next i
Used abritrary look-up in A for matching (match) and an output of B (index).

Answer 2

So it sounds like you want a unique list of values. Have you considered using a dictionary object? Dictionary objects in Excel VBA have a method to allow you to check if a value already exists in the dictionary. This allows you the ability to easily populate the dictionary with only unique values by checking that a value you're considering adding to the dictionary doesn't already exist in the dictionary.
If this sounds promising to you, then I encourage you to visit the following resource to learn more about how to use dictionaries in VBA:
https://excelmacromastery.com/vba-dictionary/#A_Quick_Guide_to_the_VBA_Dictionary
You'll want to be using the following exists method:
dict.Exists(Key)
To check if a value is already in the dictionary.
Please let me know if this answer isn't clear enough, because I can elaborate if necessary.

Answer 3

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
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