Compare 2 ranges add new items to end of range - excel

Question

I have a range in column D and a range in column F. These ranges contain strings, the strings in column D are unique (i.e. they do not repeat) and the strings in column F are also unique. However, column D and F should both contain the same strings most of the time, although they may be in a different order. The strings look something similar to:
tag:(0004)X-axis
tag:(0005)Z-axis
tag:(0005)X-axis
tag:(0006)Z-axis
Sometimes column D may be missing some of the strings or it may have some new strings. I want to compare column D to column F and if there are new strings in column D, I want to add (append) them to the end of column F. Here is a simple Example using simply a,b,c instead of "tag:(00... bla... bla...":
Column D Column F
a b
b c
c d
e e
f g
g
Column D is missing "d" but has "a" and "f"... so "a" and "f" will be added (apended) to the end to column F, like this:
Column F
b
c
d
e
g
a
f
I was trying to use this as a less direct route but I can't even get this to work:
Sub RT_COMPILER()
Dim Lastrow As Long
Dim r As Long
Dim n As Long
For r = 1 To Lastrow
n = Application.WorksheetFunction.CountIf(Range("D:D"), Cells(r, 6))
If n = 0 Then
Cells(r, 7) = Cells(r, 4)
Else
Cells(r, 7) = ""
End If
Next
End Sub
My thinking was: If I could get the new strings into column G... then delete the blank spaces then copy and paste them appending them to the end of column F... but it seems to just identify that the last item in column D is "g" and the last item in column F is blank and it would pull a "g" out of the list even though it already had a "g"...
When I originally found this code it had:
n = Application.WorksheetFunction.CountIf("D:D", Cells(r, 6))
it didn't work so I changed it to:
n = Application.WorksheetFunction.CountIf(Range("D:D"), Cells(r, 6))

Answer 1

This could be a bit overkill for Excel development, but in the long run, it is a good idea to work with Dictionary data type, as it is optimized to store unique values. Thus, once you find a way to pass the cells data to a dictionary, this is a way to add the missing values of setA to setB:
Sub TestMe()
Dim setA As Object
Dim setB As Object
Set setA = CreateObject("Scripting.Dictionary")
Set setB = CreateObject("Scripting.Dictionary")
AddToDictionaryIfNotPresent "A", setA
AddToDictionaryIfNotPresent "B", setA
AddToDictionaryIfNotPresent "C", setA
AddToDictionaryIfNotPresent "D", setA
AddToDictionaryIfNotPresent "A", setB
AddToDictionaryIfNotPresent "B", setB
AddToDictionaryIfNotPresent "A", setB 'C is missing!
AddToDictionaryIfNotPresent "D", setB
Dim var As Variant
For Each var In setA
If Not ValueExistsInCollection(var, setB) Then
Debug.Print "Adding "; var
AddToDictionaryIfNotPresent var, setB
End If
Next
End Sub
And these are the additional functions:
Public Function AddToDictionaryIfNotPresent(myValue As Variant, myDictionary As Object)
If Not myDictionary.Exists(myValue) Then myDictionary.Add myValue, 1
End Function
Public Function ValueExistsInCollection(myValue As Variant, myDictionary As Object) As Boolean
Dim var As Variant
For Each var In myDictionary
If var = myValue Then
ValueExistsInCollection = True
Exit Function
End If
Next var
End Function
At the end, all the unique values are at setB:

Answer 2

I think your CountIf was looking in the wrong column.
I recommend the following approach:
Option Explicit
Public Sub CompareAndAppend()
Dim ws As Worksheet 'define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
Dim NextFreeRow As Long
NextFreeRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row + 1
Dim cnt As Long
Dim iRow As Long
For iRow = 1 To LastRow 'loop through column D
cnt = Application.WorksheetFunction.CountIf(ws.Range("F:F"), ws.Cells(iRow, "D"))
If cnt = 0 Then 'this value is missing in F, append it
ws.Cells(NextFreeRow, "F").Value = ws.Cells(iRow, "D")
NextFreeRow = NextFreeRow + 1 'move to next free row
End If
Next iRow
End Sub
The red ones were added.
A probably faster version would be using arrays and a dictionary:
Public Sub CompareAndAppendSpeedyGonzales()
Dim ws As Worksheet 'define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim InputArr() As Variant
InputArr = ws.Range("D1", ws.Cells(ws.Rows.Count, "D").End(xlUp)).Value
Dim CompareArr() As Variant
CompareArr = ws.Range("F1", ws.Cells(ws.Rows.Count, "F").End(xlUp)).Value
Dim AppendArr As Variant
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
'add column F
For i = LBound(CompareArr, 1) To UBound(CompareArr, 1)
If Not dict.exists(CompareArr(i, 1)) Then
dict.Add CompareArr(i, 1), 0
End If
Next i
'add column D
For i = LBound(InputArr, 1) To UBound(InputArr, 1)
If Not dict.exists(InputArr(i, 1)) Then
dict.Add InputArr(i, 1), 0
If IsEmpty(AppendArr) Then
ReDim AppendArr(1 To 1)
AppendArr(1) = InputArr(i, 1)
Else
ReDim Preserve AppendArr(1 To UBound(AppendArr) + 1)
AppendArr(UBound(AppendArr)) = InputArr(i, 1)
End If
End If
Next i
ws.Cells(ws.Rows.Count, "F").End(xlUp).Offset(1, 0).Resize(RowSize:=UBound(AppendArr)).Value = Application.WorksheetFunction.Transpose(AppendArr)
End Sub

Answer 3

Option Explicit
Sub test()
Dim LastrowD As Long, i As Long, LastrowF As Long, Times As Long
Dim cell As Range, rngToSearch As Range
Dim str As String
With ThisWorkbook.Worksheets("Sheet5")
LastrowD = .Cells(.Rows.Count, "D").End(xlUp).Row
For i = 1 To LastrowD
str = .Range("D" & i).Value
LastrowF = .Cells(.Rows.Count, "F").End(xlUp).Row
Set rngToSearch = .Range("F1:F" & LastrowF)
Times = Application.WorksheetFunction.CountIf(rngToSearch, str)
If Times = 0 Then
.Range("F" & LastrowF + 1) = str
End If
Next i
End With
End Sub