CODEWITHSUNDEEP
excelvba
RawrRawr7
RawrRawr7

Reputation: 353

Compare two column in the same worksheet VBA

I am trying to compare data from column B to column AB within the same worksheet. If there is a match, then I want to delete the match from column AB. Once the match is complete, I would like to copy the remaining data into column Z.

What I have researched so far is this, but I am not comparing with the the same column on different workbooks.

I have attached some screenshots seen below:

ColumnA ColumnAB

My current code is here `

Sub CompareNRemove()

For i = 1 To last_cell_B
        For j = 1 To last_cell_AB
        If Worksheets("Sheet1").Range("B" & i).Value = Worksheets("Sheet1").Range("AB" & j).Value Then
           Worksheets("Sheet2").Range("C" & i).Value = Worksheets("sheet2").Range("b" & j).Value
        End If
        Next j
    Next i

 Next r

 'Sheets("Sheet1").Range("AB18:AC999").ClearContents
 'Call MatchNSortW

End Sub


For r = 18 To Cells(Rows.Count, "E").End(xlUp).row     ' From row 1 to the last row with data
    On Error Resume Next

    myCountif = ThisWorkbook.Sheets("Sheet1").Cells(r, "E")
    myLookup = ThisWorkbook.Sheets("Sheet1").Cells(r, "E")

    MyAnswer = Application.WorksheetFunction.Application.Countif(Range("AB18:AB999"), Cells(r, "E"))


    If MyAnswer = 1 Then
    Match = Application.WorksheetFunction.Application.VLookup(myLookup, ThisWorkbook.Sheets("Sheet1").Range("AB18:AB999"), 1, 0)
    Cells(r, "B").Value = Match


    'Check = Application.WorksheetFunction.Application.VLookup(Match, Range("AB18:AB999"), 0)
    'Cells(r, "D").Value = Check

    'Check it off the list
    'Check = Application.WorksheetFunction.Application.Match(Cells(r, "B"), Range("AB18:AB999"), 0)


    'Checkup = Application.WorksheetFunction.Application.Match(MyAnswer, ThisWorkbook.Sheets("Sheet1").Range("AB18:AB999"), 0)



    ElseIf MyAnswer = 0 Then
    Cells(r, "B").Value = ""

    End If



 Next r

'Sheets("Sheet1").Range("AB18:AC999").ClearContents
'Call MatchNSortW

End Sub`

Upvotes: 0

Views: 79

Answers (1)

user11138753
user11138753

Reputation:

This will take the values in column AB that do not exist in column B and put them into column Z. If you also want to remove the duplicated values from column AB then just clear column AB and transfer the same values there.

Sub CompareNRemove()

    dim i as long, arrB as variant, arrAB as variant, z as object

    set z = createobject("scripting.dictionary")

    with worksheets("sheet101")

        arrB = .range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup)).value
        arrAB = .range(.cells(2, "AB"), .cells(.rows.count, "AB").end(xlup)).value

        for i=lbound(arrab, 1) to ubound(arrab, 1)
            if arrab(i, 1) <> vbnullstring then
                if iserror(application.match(arrab(i, 1), arrb, 0)) then
                    z.item(arrab(i, 1)) = vbnullstring
                end if
            end if
        next i

        .cells(2, "Z").resize(z.count, 1) = application.transpose(z.keys)

    end with

end sub

Upvotes: 1

Related Questions