VBA - Find Duplicates in Column A and then check to see if there a cell value in Column B

user_17388915 0
Viewed 99

I've been trying to create a vba macros that finds duplicates in Column A but then checks to see if there is a certain value in Column B. (For ex: If a duplicate is found check to see if the cell next to it equals 202112. If a match is found then highlight both of them in yellow but if the cell does not match then don't highlight)

If match: enter image description here

If not a match: enter image description here

Sub Format()

Dim cell As Range
Dim wbook As Workbook
Dim wsheet As Worksheet
Dim sname As Range
Dim cname As Range
Dim rngA As Range
Dim dupA As Range
Dim dupB As Range
Dim strName As String


Set wbook = ActiveWorkbook 'Current Workbook
Set wsheet = Sheets("OFA_CP_OUT_202112_Without_Match") 'Worksheet Name
Set sname = Range("A2:H2426") 'Range for sorting and aligning columns A:H
Set cname = Sheets("OFA_CP_OUT_202112_Without_Match").Range("F2:F2426") 'Sheet Name & Range to format currency
Set rngA = Range("A2:A2426") 'Range to change column A to uppercase & find if a cell contains an A, B or S
Set dupA = wsheet.Range("A2:A2426") 'Range to find duplicates in column A
Set dupB = wsheet.Range("B2:B2426") 'Range to find year & month in column B (ex: 202112)
strName = "202112" 'year & month to search for in column B

'Looks for duplicates and highlights them yellow in column A & column B
For Each cell In dupA
        If WorksheetFunction.CountIf(dupA, cell.Value) > 1 Then
                cell.Interior.ColorIndex = 6
        End If
    Next cell

For Each cell In dupB
    If InStr(cell.Value, strName) Then
        cell.Interior.ColorIndex = 6
    End If
Next cell

The only way I've gotten close is to just find duplicates in both columns.

Thanks for your help!!

vba excel
1 Answers

You can try WorksheetFunction COUNTIFS. COUNTIFS can identify consolidated duplicates in multiple ranges. It returns result >1 if that data of consolidated rows duplicated:

COUNTIFS(dupA,"="&valueA,dupB,"="&valueB)

VBA looks like (looping through 1 column only, this sample in dupA):

For Each cell in dupA    
If Application.CountIfs(dupA, "=" & cell.Value, dupB, "=" & cell.Offset(0, 1).Value) > 1 Then
    cell.Interior.ColorIndex = 6
    cell.Offset(0, 1).Interior.ColorIndex = 6
End If
Next cell

Here is the result:

enter image description here

Please make sure your cells have no highlight before you run, since the script will only change format of cells that do meet conditions. Or you can prepare a script to clear existing highlight (if any) of your data range. Just to prevent mess up of highlight (before - after).

user_119167590
Related