Compare records in 2 columns, and delete repeated ones

[Aretradeser]

In 2 contiguous columns, A and B, where column A will always have 50 records and in B, 30, I need a code that compares both columns, and if you find records from column B in column A, delete them from column A, and those left in column A, copy them to another column, column C.

 

[kweaver]

I thought for sure some VBA ringer in here would have a solution to this.
I'm far from a ringer...very far...but I'm not only learning and following what the ringers have done but I look for a solution.
Even if my solution isn't ideal or ugly...I think I have a solution.

Did I understand your problem?

Sub FindDups()

Dim Aary As Variant, Bary As Variant, Cary(1 To 51) As String
Dim i As Long
Aary = Application.Transpose(Sheets("Sheet3").Range("A1:A51"))
Bary = Application.Transpose(Sheets("Sheet3").Range("B1:B31"))
' my test data is on Sheet3 in my test workbook and there are column headers in row 1
For i = 1 To 51
If IsError(Application.Match(Sheets("Sheet3").Cells(i, 1), Sheets("Sheet3").Range("B1:B31"), 0)) Then
  Cary(i) = Sheets("Sheet3").Cells(i, 1)
Else
Aary(i) = "REMOVE"
End If
Next i
For i = 1 To 51
Sheets("Sheet3").Cells(i, 1) = Aary(i) 
Sheets("Sheet3").Cells(i, 3) = Cary(i)
Next i
' now delete rows
For i = 51 To 1 Step -1
    If Range("A" & i) = "REMOVE" Or Range("C" & i) = "" Then
        Rows(i).Delete
    End If
Next i
For i = 1 To 31
Sheets("Sheet3").Range("B" & i) = Bary(i)
Next i
Sheets("Sheet3").Range("C1") = "New A"
End Sub

 

[kweaver]

Made an error in coping it. And, I think I made a mistake. SIGH

Sub FindDups()

Dim Aary As Variant, Bary As Variant, Cary(1 To 51) As String
Dim i As Long
Aary = Application.Transpose(Sheets("Sheet3").Range("A1:A51"))
OAary = Application.Transpose(Sheets("Sheet3").Range("A1:A51")) ' probably don't need the old A column
Bary = Application.Transpose(Sheets("Sheet3").Range("B1:B31"))
' my test data is on Sheet3 in my test workbook
For i = 1 To 51
If IsError(Application.Match(Sheets("Sheet3").Cells(i, 1), Sheets("Sheet3").Range("B1:B31"), 0)) Then
  Cary(i) = Sheets("Sheet3").Cells(i, 1)
Else
Aary(i) = "REMOVE"
End If
Next i
For i = 1 To 51
Sheets("Sheet3").Cells(i, 1) = Aary(i)
Sheets("Sheet3").Cells(i, 3) = Cary(i)
Next i
' now delete rows
For i = 51 To 1 Step -1
    If Range("A" & i) = "REMOVE" Or Range("C" & i) = "" Then
        Rows(i).Delete
    End If
Next i
For i = 1 To 31
Sheets("Sheet3").Range("B" & i) = Bary(i)
Next i
For i = 1 To 51
Sheets("Sheet3").Range("A" & i) = Aary(i)
Next i
Sheets("Sheet3").Range("C1") = "New A"
End Sub

 

[kweaver]

I think I fixed my stupidity.

Sub FindDups()

Dim Aary As Variant, Bary As Variant, Cary(1 To 51) As String
Dim i As Long
Aary = Application.Transpose(Sheets("Sheet3").Range("A1:A51"))
' OAary = Application.Transpose(Sheets("Sheet3").Range("A1:A51"))
Bary = Application.Transpose(Sheets("Sheet3").Range("B1:B31"))
' my test data is on Sheet3 in my test workbook
For i = 1 To 51
If IsError(Application.Match(Sheets("Sheet3").Cells(i, 1), Sheets("Sheet3").Range("B1:B31"), 0)) Then
  Cary(i) = Sheets("Sheet3").Cells(i, 1)
Else
Aary(i) = "REMOVE"
End If
Next i
For i = 1 To 51
 Sheets("Sheet3").Cells(i, 1) = Aary(i)
 Sheets("Sheet3").Cells(i, 3) = Cary(i)
Next i
' now delete rows
For i = 51 To 1 Step -1
    If Range("A" & i) = "REMOVE" Then
    'If Range("A" & i) = "REMOVE" Or Range("C" & i) = "" Then
        Rows(i).Delete
    End If
Next i
For i = 1 To 31
 Sheets("Sheet3").Range("B" & i) = Bary(i)
Next i
For i = 1 To 51
 If Aary(i) <> "REMOVE" Then
 Sheets("Sheet3").Range("C" & i) = Aary(i)
 Else
 End If
Next i
Sheets("Sheet3").Range("C1") = "New A"
End Sub

 

[mohadin]

Well
What about

Sub test()
    Dim a, b As Variant, i
    a = Range("a1:a50")
    b = Range("b1:b30")
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a): If Not .exists(a(i, 1)) Then .Add a(i, 1), 1: Next
        For i = 1 To UBound(b): If .exists(b(i, 1)) Then .Remove b(i, 1): Next
        Cells(1, 3).Resize(.Count) = Application.Transpose(.keys)
    End With
End Sub

 

[Aretradeser]

Well
What about

Sub test()
    Dim a, b As Variant, i
    a = Range("a1:a50")
    b = Range("b1:b30")
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a): If Not .exists(a(i, 1)) Then .Add a(i, 1), 1: Next
        For i = 1 To UBound(b): If .exists(b(i, 1)) Then .Remove b(i, 1): Next
        Cells(1, 3).Resize(.Count) = Application.Transpose(.keys)
    End With
End Sub

The following error occurs when executing the code:

Compilation error:
Next without For

 

[mohadin]

Then try

Sub test()
    Dim a, b As Variant, i
    a = Range("a1:a50")
    b = Range("b1:b30")
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If Not .exists(a(i, 1)) Then .Add a(i, 1), 1
        Next
        For i = 1 To UBound(b)
            If .exists(b(i, 1)) Then .Remove b(i, 1)
        Next
        Cells(1, 3).Resize(.Count) = Application.Transpose(.keys)
    End With
End Sub

Let me know

 

[kweaver]

Then try

Sub test()
    Dim a, b As Variant, i
    a = Range("a1:a50")
    b = Range("b1:b30")
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If Not .exists(a(i, 1)) Then .Add a(i, 1), 1
        Next
        For i = 1 To UBound(b)
            If .exists(b(i, 1)) Then .Remove b(i, 1)
        Next
        Cells(1, 3).Resize(.Count) = Application.Transpose(.keys)
    End With
End Sub

Let me know

NICE.

 

[Aretradeser]

Muchas gracias a todos por vuestras repuestas.

 

[mohadin]

De nada
Y gracias por los comentarios
Sea feliz y seguro