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