Find the 2 column values and search in reverse in same 2 columns

ivandgreat · Feb 15th 2016

Hello,

Can anyone help me how to to check in vba the values for two columns (NameA and NameB) and check it on reverse columns (NameB and NameA) and highlights the duplicates if found

[TABLE="width: 200"]

[tr]

[td]

Item

[/td]

[td]

NameA

[/td]

[td]

TerminalA

[/td]

[td]

NameB

[/td]

[td]

TerminalB

[/td]

[td]

Remarks

[/td]

[/tr]

[tr]

[td]

1

[/td]

[td]

2000

[/td]

[td]

XXX1

[/td]

[td]

2001

[/td]

[td]

XXX2

[/td]

[td]

Duplicate@item4

[/td]

[/tr]

[tr]

[td]

2

[/td]

[td]

2002

[/td]

[td]

YYYA

[/td]

[td]

2003

[/td]

[td]

YYYB

[/td]

[td]

Duplicate@item6

[/td]

[/tr]

[tr]

[td]

3

[/td]

[td]

XYZ22

[/td]

[td]

ABCA

[/td]

[td]

XYZ11

[/td]

[td]

ABCB

[/td]

[td]

no Duplicate

[/td]

[/tr]

[tr]

[td]

4

[/td]

[td]

2001

[/td]

[td]

XXX2

[/td]

[td]

2000

[/td]

[td]

XXX1

[/td]

[td]

Duplicate@item1

[/td]

[/tr]

[tr]

[td]

5

[/td]

[td]

2003

[/td]

[td]

YYYB

[/td]

[td]

2002

[/td]

[td]

YYYA

[/td]

[td]

Duplicate@item2

[/td]

[/tr]

[tr]

[td]

6

[/td]

[td]

2000

[/td]

[td]

ZZZA

[/td]

[td]

2002

[/td]

[td]

ZZZB

[/td]

[td]

no Duplicate

[/td]

[/tr]

[/TABLE]

br,

Ivan

shknbk2 · Feb 15th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Try this code:

Code

Sub findDuplicates()
    Dim sName As String, sTerm As String


    Dim rName As Range, rTerm As Range
    Dim i As Integer, sAddr As String
    
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        sName = Cells(i, 2).Value
        sTerm = Cells(i, 3).Value
        Range("D1").Select
        sAddr = ActiveCell.Address
        Do
            On Error Resume Next
            Columns("D:D").Find(What:=sName, After:=Range("D1"), LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate
            On Error GoTo 0
            If ActiveCell.Address <> sAddr Then
                If ActiveCell.Offset(, 1).Value = sTerm Then
                    Cells(i, 6).Value = "Duplicate@item" & Cells(ActiveCell.Row, 1).Value
                    Exit Do
                Else
                    sAddr = ActiveCell.Address
                End If
            Else
                Cells(i, 6).Value = "no Duplicate"
                Exit Do
            End If
        Loop
    Next i
End Sub

Display More

ivandgreat · Feb 16th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Thanks a lot shknbk2.

I tested it on some other data, it gives an error... some was found "no duplicates" but when i check it has duplicates, and the remarks has found the duplicate.
Please see below table results.

[TABLE="width: 421"]

[tr]

[td]

Item

[/td]

[td]

NameA

[/td]

[td]

TerminalA

[/td]

[td]

NameB

[/td]

[td]

TerminalB

[/td]

[td]

Remarks

[/td]

[/tr]

[tr]

[TD="align: right"]1[/TD]

[td]

3000

[/td]

[td]

W07B

[/td]

[td]

4884

[/td]

[td]

W07A

[/td]

[td]

no Duplicate

[/td]

[/tr]

[tr]

[TD="align: right"]159[/TD]

[td]

4884

[/td]

[td]

W07A

[/td]

[td]

3000

[/td]

[td]

W07B

[/td]

[td]

Duplicate@item1

[/td]

[/tr]

[tr]

[TD="align: right"]79[/TD]

[td]

4841

[/td]

[td]

B20B

[/td]

[td]

4840

[/td]

[td]

B20A

[/td]

[td]

Duplicate@item70

[/td]

[/tr]

[tr]

[TD="align: right"]70[/TD]

[td]

4840

[/td]

[td]

B20A

[/td]

[td]

4841

[/td]

[td]

B20B

[/td]

[td]

no Duplicate

[/td]

[/tr]

[/TABLE]

What if i wanted to transfer the whole rows for duplicates to another sheet and remain the unique rows only.

br,

shknbk2 · Feb 16th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Upload the spreadsheet that causes these errors. The only way for me to find out is to use your data. Also include in the uploaded workbook additional sheets showing what you want the results to look like after transferring the rows.

ivandgreat · Feb 16th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Dear shknbk2,

Thanks a lot.

Please see attached file.

All duplicated rows should be transferred @ sheet2 with the same table format as sheet1, same remarks as we had, mentioning from which rows it was duplicated for both sheets

br,

skywriter · Feb 16th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Quote

I tested it on some other data, it gives an error... some was found "no duplicates" but when i check it has duplicates, and the remarks has found the duplicate.
Please see below table results.

Give an example or two of which ones are wrong. I wrote a program also and tested it against your attached file in post #5 along with shknbk2's code. I get identical results. So give an example of one that's a duplicate that comes up as not a duplicate.

ivandgreat · Feb 17th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

hi skywiter,

as per my attached file and shknbk2's code, after i run the code, please filter @ colum TerminalB.

Here it shows no Duplicate @ row20 but it shows Duplicate@item20 @ row 479, same with the other one.

The duplicate should not show from Col NameA & TerminalA to Col NameB & TerminalB.

[TABLE="width: 421"]

[tr]

[td]

Item

[/td]

[td]

NameA

[/td]

[td]

TerminalA

[/td]

[td]

NameB

[/td]

[td]

TerminalB

[/td]

[td]

Remarks

[/td]

[/tr]

[tr]

[TD="align: right"]20[/TD]

[td]

2002

[/td]

[td]

D7AB

[/td]

[td]

2191

[/td]

[td]

D7AA

[/td]

[td]

no Duplicate

[/td]

[/tr]

[tr]

[TD="align: right"]479[/TD]

[td]

2191

[/td]

[td]

D7AA

[/td]

[td]

2002

[/td]

[td]

D7AB

[/td]

[td]

Duplicate@item20

[/td]

[/tr]

[tr]

[TD="align: right"]1023[/TD]

[td]

2326

[/td]

[td]

DLOB

[/td]

[td]

4178

[/td]

[td]

DLOA

[/td]

[td]

no Duplicate

[/td]

[/tr]

[tr]

[TD="align: right"]1027[/TD]

[td]

4178

[/td]

[td]

DLOA

[/td]

[td]

2326

[/td]

[td]

DLOB

[/td]

[td]

Duplicate@item1023

[/td]

[/tr]

[/TABLE]

br,

skywriter · Feb 17th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Okay, try mine.
It's slower, but I seem to get the right answers for those two items.

Code

Sub ivandgreat()
Dim a, b, z, c1 As Long, c2 As Long
Dim rngData As Range
With Cells(1).CurrentRegion
    Set rngData = .Offset(1).Resize(.Rows.Count - 1)
End With
 z = rngData.Value
 a = Application.Index(z, Evaluate("row(1:" & UBound(z, 1) & ")"), Array(2, 4))
 b = Application.Index(z, Evaluate("row(1:" & UBound(z, 1) & ")"), Array(4, 2))
   For c1 = LBound(a, 1) To UBound(a, 1)
        For c2 = LBound(a, 1) To UBound(a, 1)
        If c1 = c2 Then GoTo 1
            If a(c1, 1) = b(c2, 1) And a(c1, 2) = b(c2, 2) Then
                z(c1, 6) = "Duplicate@item " & z(c2, 1)
                GoTo 2
            End If
1      Next c2
        z(c1, 6) = "No duplicate"
2 Next c1
rngData.Value = z
End Sub

Display More

ivandgreat · Feb 17th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Thanks a lot, skywriter, it works perfectly fine.

What if i wanted to transfer/separate all duplicated rows to sheet2 and remain only the unique values on sheet1?

br,

skywriter · Feb 17th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Try this on a copy. :cool:

Code

Sub ivandgreat()
Dim a, b, z, c1 As Long, c2 As Long
Dim rngData As Range
Application.ScreenUpdating = False
With Cells(1).CurrentRegion
    Set rngData = .Offset(1).Resize(.Rows.Count - 1)
End With
 z = rngData.Value
 a = Application.Index(z, Evaluate("row(1:" & UBound(z, 1) & ")"), Array(2, 4))
 b = Application.Index(z, Evaluate("row(1:" & UBound(z, 1) & ")"), Array(4, 2))
   For c1 = LBound(a, 1) To UBound(a, 1)
        For c2 = LBound(a, 1) To UBound(a, 1)
        If c1 = c2 Then GoTo 1
            If a(c1, 1) = b(c2, 1) And a(c1, 2) = b(c2, 2) Then
                z(c1, 6) = "Duplicate@item " & z(c2, 1)
                GoTo 2
            End If
1      Next c2
        z(c1, 6) = "No duplicate"
2 Next c1
rngData.Value = z
With Range("A1").CurrentRegion
    .AutoFilter 6, "<>" & "No duplicate"
    .Copy Worksheets("Sheet2").Range("A1")
    .Offset(1).EntireRow.Delete
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Display More

ivandgreat · Feb 17th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Thanks again, skywriter.

What i mean is, @ sheet 1

[TABLE="width: 427"]

[tr]

[td]

Item

[/td]

[td]

NameA

[/td]

[td]

TerminalA

[/td]

[td]

NameB

[/td]

[td]

TerminalB

[/td]

[td]

Remarks

[/td]

[/tr]

[tr]

[TD="align: right"]352 [/TD]

[td]

2137

[/td]

[td]

DKJB

[/td]

[td]

1

[/td]

[td]

DKJA

[/td]

[td]

Duplicate@item 1

[/td]

[/tr]

[tr]

[TD="align: right"]8[/TD]

[td]

58

[/td]

[td]

DKLA

[/td]

[td][/td]

[td]

DKLB

[/td]

[td]

No duplicate

[/td]

[/tr]

[/TABLE]

Then @ sheet 2
[TABLE="width: 427"]

[tr]

[td]

Item

[/td]

[td]

NameA

[/td]

[td]

TerminalA

[/td]

[td]

NameB

[/td]

[td]

TerminalB

[/td]

[td]

Remarks

[/td]

[/tr]

[tr]

[TD="align: right"]1[/TD]

[td]

1

[/td]

[td]

DKJA

[/td]

[td]

2137

[/td]

[td]

DKJB

[/td]

[td]

Duplicate@item 352

[/td]

[/tr]

[/TABLE]

br,

skywriter · Feb 17th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

You know, you are really complicating things by not just stating what you wanted from the beginning. You said you just wanted to find some things, now you want to do something more complicated, so I feel like I've completely wasted my time writing code for you.

This is not how I would have written this code had I known what you wanted.

My suggestion would be to start a new thread.

ivandgreat · Feb 17th 2016

Re: Find the 2 column values and search in reverse in same 2 columns

Thanks skywriter..

I really appreciated your code.

Have a nice day!

Find the 2 column values and search in reverse in same 2 columns

Participate now!

Share