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

Question

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

I'm having a hard time creating a macro that can check the equality between each cell in a list, and if both are different, leave a blank line above the cell.

For example:

A TO

B C

C D

D E

AND F

G H

Leaving:

A TO

B

C C

D D

E E

F

G

H

I have to check if the two lists of names are the same, and for each error I have to make a notification (so the empty cell). I can't mix the errors from each list.

The Code I have so far is kind of 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

Was trying to make it work like this:

    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.

2

excel vba visual-basic-6 excel-vba

Author: Comunidade, 2019-02-19

Source

1 answers

score 0 · Answer 1

Hello, in that case I could try the following code, but it doesn't fix the mess. And if you need to adjust something, let me know!

Changed:

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