Home > database >  Check if value exists in two columns in VBA and highlight them, leaving out excess duplicates in eit
Check if value exists in two columns in VBA and highlight them, leaving out excess duplicates in eit

Time:12-29

I am trying to get VBA to look at values in one column, and then check if the same value exists in another column.

I am then trying to highlight the same number of cells in both columns where the same value shows up, meaning that if the same value shows up a different amount of times in one column than in the other, I need to highlight the same amount of cells in each column and leave any "excess" duplicate values without highlight.

The picture illustrates what I am trying to accomplish. EXCEL SCREENSHOT

As seen in the picture, the values have been highlighted to the degree that they show up in either column, leaving the additional duplicate values without highlight.

I tried this code but it did not work and highlighted cells that I did not expect to get highlighted. I tried to loop through the columns and ignore already highlighted cells.

Sub highlightMatchingValues()

'Declare variables
    Dim cellC As Range, cellE As Range

'Loop through each cell with a value in column C
       For Each cellC In Range("C:C").Cells
        If Not IsEmpty(cellC) And cellC.Interior.ColorIndex = xlNone Then 'ignore empty cells and cells that are already highlighted

'Loop through each cell with a value in column E
     For Each cellE In Range("E:E").Cells
            If Not IsEmpty(cellE) And cellE.Interior.ColorIndex = xlNone Then 'ignore empty cells and cells that are already highlighted
                 If cellC.value = cellE.value Then 'check for a match

'Highlight both cells green
    cellC.Interior.Color = vbGreen
    cellE.Interior.Color = vbGreen


               End If
             End If
         Next cellE
    End If
    Next cellC

End Sub

CodePudding user response:

here comes a solution that can solve your problem

'Sheet name = sheetName

'First columns variables (column C = index 3)
Dim firstLine1 As Long
Dim lastLine1 As Long

firstLine1 = 1
lastLine1 = Worksheets("sheetName").Cells(Rows.Count, 3).End(xlUp).Row
    
'Second columns variables (column E = index 5)
Dim firstLine2 As Long
Dim lastLine2 As Long

firstLine2 = 1
lastLine2 = Worksheets("sheetName").Cells(Rows.Count, 5).End(xlUp).Row

'loop
For i = firstLine1 To lastLine1
    For j = firstLine2 To lastLine2
        If (Worksheets("sheetName").Cells(i, 3).Value = Worksheets("sheetName").Cells(j, 5)) Then
            If (Worksheets("sheetName").Cells(j, 5).Interior.Color <> vbGreen) Then
                Worksheets("sheetName").Cells(i, 3).Interior.Color = vbGreen
                Worksheets("sheetName").Cells(j, 5).Interior.Color = vbGreen
                Exit For
            End If
        End If
    Next j
Next i
  • Related