(VBA) Search duplicates in one columns, determine it by another

sh1ne

New Member
Joined
Jul 3, 2017
Messages
33
Office Version
  1. 2016
Platform
  1. Windows
Hi Guys,

I want to describe my problem as much as I can. My target is to create macro which will highlight the duplicated rows searching in column B, but all is determinated by Column A. Values in column B can be same and not highlighted if values in column A are different. CountIf is good for highlight cells within range for only duplicates, what about conditional highlight? InStr would be good, but how I can store informations about which cells are need to be compared(there can be more than 1000 rows)

To make it clear, below is example:

colA____colB
ABC____XYZ
ABC____YZX
BCA____XYZ
BCA____ZXY
CBA____XYZ
ABC____XYZ

As you see, there are many XYZ in column B, but everything is ok if colA is different. Any ideas how macro should look like?
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
No need of VBA - you can use Conditional Formatting with this formula

=COUNTIFS($A$2:$A$2000,$A2,$B$2:$B$2000,$B2)>1
Assumes headers in row 1; data beginning in row 2

M.
 
Last edited:
Upvote 0
Thanks a lot, but there's any way to avoid formulas? File is generated by another macro and want avoid opening excel and doing something manually.

Formula is helping me a lot, but there's still to do.
 
Upvote 0
Thanks a lot, but there's any way to avoid formulas? File is generated by another macro and want avoid opening excel and doing something manually.

Formula is helping me a lot, but there's still to do.

If you don't want to use formulas, even in VBA, maybe this macro.

Code:
Sub HihglightDupes()
    Dim dic As Object
    Dim lastRow As Long, vData As Variant, i As Long, rCell As Range
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    vData = Range("A2:B" & lastRow)
    For i = LBound(vData, 1) To UBound(vData, 1)
        dic(vData(i, 1) & "|" & vData(i, 2)) = dic(vData(i, 1) & "|" & vData(i, 2)) + 1
    Next i
    
    For Each rCell In Range("A2:A" & lastRow)
        If dic(rCell.Value & "|" & rCell.Offset(, 1).Value) > 1 Then
            rCell.Resize(, 2).Font.Color = vbRed
        End If
    Next rCell
End Sub

Hope this helps

M.
 
Last edited:
Upvote 0
Thanks a lot Marcelo, as I seen it's working on Windows. However on Mac I get message like this "ActiveX component can't create object" on that line:
Set dic = CreateObject("Scripting.Dictionary")
As I know Mac OS does not have the Scripting Runtime library so I'wont be able to do that. There's any chance to avoid it?


Thanks once more Marcelo for your feedback.
 
Upvote 0
I have no experience with Mac - see if this works

Code:
Sub HihglightDupes()
    Dim lastRow As Long, rCell As Range
    Dim lCounter As Long
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For Each rCell In Range("A2:A" & lastRow)
        lCounter = _
            Evaluate(Replace("=COUNTIFS(A2:A@,""" & rCell.Value & """,B2:B@,""" & rCell.Offset(, 1) & """)", "@", lastRow))
        If lCounter > 1 Then rCell.Resize(, 2).Font.Color = vbRed
    Next rCell
End Sub

M.
 
Upvote 0
@ Marcelo Hope I can ask a question. dic(vData(I, 1) & "|" & vData(i, 2)) = dic(vData(i, 1) & "|" & vData(i, 2)) + 1

this joins Column A & Column B and starts at row 2?
 
Upvote 0
@ Marcelo Hope I can ask a question. dic(vData(I, 1) & "|" & vData(i, 2)) = dic(vData(i, 1) & "|" & vData(i, 2)) + 1

this joins Column A & Column B and starts at row 2?
 
Upvote 0
@ Marcelo Hope I can ask a question. dic(vData(I, 1) & "|" & vData(i, 2)) = dic(vData(i, 1) & "|" & vData(i, 2)) + 1

this joins Column A & Column B and starts at row 2?

Yes, as vDdata is a two dimensional array when i=1 the code concatenates A2&"|"&B2; when i =2, A3&"|"&B3 and so on.

M.
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,144
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top