VBA, create a macro so that I can compare two lists of names?

Question

I’m having trouble creating a macro that can check the equality between each cell of a list and, if both are different, leave a blank line above the cell.

For example:

TO THE

B C

C D

D AND

AND F

G H

Leaving:

TO THE

B

C C

D

AND AND

    F

G

    H

I have to check if the two lists of names are equal, and for each error I have to make a notification (hence the empty cell). I can’t mix up the mistakes on each list.

The Code I have so far is somewhat discouraging.

 Private Sub compare_cells(ByVal Target1 As Range, ByVal Target2 As Range)
If Target1 Is Nothing Then Exit Sub
If Target2 Is Nothing Then Exit Sub

Dim ws1, ws2 As Worksheet

Set ws1 = Sheets(Target1.Parent.Name)
Set ws2 = Sheets(Target2.Parent.Name)
    If Target1.Value <> Target2.Value Then
        ' If they don't match place your code here
        ws1.Range(Target1.Row & ":" & Target1.Row).Insert Shift:=xlDown
        ws2.Range(Target2.Row & ":" & Target2.Row).Insert Shift:=xlDown
    End If

End Sub

I was trying to make it work that way:

    Range("A3:C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A4").Select
    ActiveSheet.Paste
    Range("B4").Select

But I’m having a hard time doing that.

Answer 1

Hello, in that case I could try the following code, but it does not repair the mess. And if you need to adjust something, let me know!

ALTERED:

Sub Organizar()
Dim aw As String
Dim ln As Long
aw = ActiveSheet.Name
For i = 1 To 3
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Range("A1").Select
    ActiveSheet.Paste
    Range("E1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Range("A1").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ln = ActiveSheet.Columns("A").Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
    Columns("A:A").Select
    ActiveWorkbook.Worksheets(aw).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(aw).Sort.SortFields.Add2 Key:=Range("A1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(aw).Sort
        .SetRange Range("A1:A" & ln)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ln = Application.WorksheetFunction.CountA(Range("A:A"))
    ActiveSheet.Range("$A$1:$A$" & ln).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B1").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],C[2],1,0),"""")"
    Range("C1").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],C[2],1,0),"""")"
    ln = Application.WorksheetFunction.CountA(Range("A:A"))
    Range("B1:C1").Select
    Selection.AutoFill Destination:=Range("B1:C" & ln)
    Columns("A:F").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("A:A").Delete Shift:=xlToLeft
    Columns("C:E").Delete Shift:=xlToLeft
    Range("A1").Select
End Sub