CODEWITHSUNDEEP
vbaexcel
Spastek
Spastek

Reputation: 25

Compare the value of a Cell in a Column on one sheet with all the values in a column on another sheet. Color the row depending on the result

I have a list of names on Sheet1 ColumnA and need to see if they appear in Sheet2 ColumnB.

If a name on Sheet1 ColumnA exist on Sheet2 ColumnB, I need to color the Row on Sheet1.ColumnA Green. If not, color the row Red.

The code that ended up working for my specific issue was this:

Sub ColorCells()
Application.ScreenUpdating = False
Dim c, Finder
With Sheets("Sheet1")
    For Each c In .Range("A1:A" & .Cells(Rows.CountLarge, "A").End(xlUp).Row)
        Set Finder = Sheets("Sheet2").Range("B:B").Find(c.Value, LookAt:=xlWhole)
        If Not Finder Is Nothing Then
            c.EntireRow.Interior.Color = RGB(180, 230, 180)
        Else
            c.EntireRow.Interior.Color = RGB(230, 180, 180)
        End If
    Next c
End With
Application.ScreenUpdating = True
End Sub

Upvotes: 1

Views: 190

Answers (2)

user1274820
user1274820

Reputation: 8144

Basic solution - this may take some time if you have incredibly large data sets.

You can change LookAt:=xlWhole to LookAt:=xlPart if you want to see if the name exists in part of the cell instead of an exact match.

Sub ColorCells()
Application.ScreenUpdating = False
Dim c, Finder
With Sheets("Sheet1")
    For Each c In .Range("A1:A" & .Cells(Rows.CountLarge, "A").End(xlUp).Row)
        Set Finder = Sheets("Sheet2").Range("B:B").Find(c.Value, LookAt:=xlWhole)
        If Not Finder Is Nothing Then
            c.Interior.Color = RGB(180, 230, 180)
        Else
            c.Interior.Color = RGB(230, 180, 180)
        End If
    Next c
End With
Application.ScreenUpdating = True
End Sub

Another way you can do this using conditional formatting

ConditionalFormatting

The formulas are:

=COUNTIFS(Sheet2!$B$1:$B$500000,A1)=0

=COUNTIFS(Sheet2!$B$1:$B$500000,A1)>0

You can change the ranges in the formula to the ranges you wish to use

You can add this to the first cell, click the Format Painter - Press F5 - and put in the range you would like it to apply to.

Finally, if your values are unique, you can use this method:

This should be a very fast method using dictionaries and variant arrays - all the comparisons are done in memory.

Sub ColorTheCells()
Dim s1, s2, r1(), r2(), d1, x
Set d1 = CreateObject("Scripting.Dictionary")
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
r1 = s1.Range("A1:A" & s1.Cells(Rows.CountLarge, "A").End(xlUp).Row).Value
r2 = s2.Range("B1:B" & s2.Cells(Rows.CountLarge, "B").End(xlUp).Row).Value
For x = LBound(r1, 1) To UBound(r1, 1)
    d1.Add r1(x, 1), x
Next x
s1.Range("A1:A" & s1.Cells(Rows.CountLarge, "A").End(xlUp).Row).Interior.Color = RGB(230, 180, 180)
For x = LBound(r2, 1) To UBound(r2, 1)
    If d1.Exists(r2(x, 1)) Then s1.Cells(d1(r2(x, 1)), s1.Cells(1, 1).Column).Interior.Color = RGB(180, 230, 180)
Next x
End Sub

Upvotes: 0

A Cohen
A Cohen

Reputation: 456

I came up with this, hopefully ,it is what You're looking for. 

Dim rcnt As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
rcnt = ws2.Range("B1", ws2.Range("B2").End(xlDown)).Rows.Count

For x = 1 To rcnt
    If ws1.Cells(x, 1) = ws2.Cells(x, 2) Then
        ws1.Cells(x, 1).EntireRow.Interior.Color = RGB(0, 255, 0)
    Else:
        ws1.Cells(x, 1).EntireRow.Interior.Color = RGB(255, 0, 0)
    End If
Next x

Upvotes: 1

Related Questions