VBA combination columns lookup in another sheet.

[jakobt]

Have a sheet1 with:
column A: with names
column B: with schools

In sheet2 I have:
column A: with names
column B: with schools

I want to look up the combination of A&B in each row in sheet 1 and colour them green if they are available in any row in sheet2.

I want to do it in vba as I also want to add a few other Or criterias later

 

[Fluff]

How about

Sub ColourSome()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("pcode")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value & "|" & Cl.Offset(, 1).Value) = Empty
      Next Cl
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value & "|" & Cl.Offset(, 1).Value) Then Cl.Resize(, 2).Interior.Color = vbGreen
      Next Cl
   End With
End Sub

 

[jakobt]

This is brilliant!!
Would like to add one more criteria.
First of all the upstanding criteria must be met.
Then if the value in column J in sheet1 for each row can be found in column E, F, G or H in sheet 2.
Only if this criteria is also met the color should be set to greeen.

 

[Fluff]

How about

Sub ColourSome()
   Dim cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("pcode")
   With CreateObject("scripting.dictionary")
      For Each cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(cl.Value & "|" & cl.Offset(, 1).Value) = Join(Application.Index(cl.Offset(, 4).Resize(, 4).Value, 1, 0), "|")
      Next cl
      For Each cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .exists(cl.Value & "|" & cl.Offset(, 1).Value) And cl.Offset(, 9).Value <> "" Then
            If InStr(1, .Item(cl.Value & "|" & cl.Offset(, 1).Value), cl.Offset(, 9).Value, vbTextCompare) > 0 Then
               cl.Resize(, 2).Interior.Color = vbGreen
            End If
         End If
      Next cl
   End With
End Sub

 

[jakobt]

Genious. I owe you one beer!

Final detail:
Instead of colouring 2 cells green. I would like the cell in column d, the cell in column j, and the cell in column N to be coloured green when the criterias are met.

 

[jakobt]

And transactions which did not live up to the criteria I would like to color red!

 

[Fluff]

Before I spend yet more time rewriting the code, are you sure that this is the last time you'll "move the goal posts"?

 

[jakobt]

This is it

 

[Fluff]

Ok, how about

Sub ColourSome()
   Dim cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("pcode")
   With CreateObject("scripting.dictionary")
      For Each cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         .Item(cl.Value & "|" & cl.Offset(, 1).Value) = Join(Application.Index(cl.Offset(, 4).Resize(, 4).Value, 1, 0), "|")
      Next cl
      For Each cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If .Exists(cl.Value & "|" & cl.Offset(, 1).Value) And cl.Offset(, 9).Value <> "" Then
            If InStr(1, .Item(cl.Value & "|" & cl.Offset(, 1).Value), cl.Offset(, 9).Value, vbTextCompare) > 0 Then
               Intersect(cl.EntireRow, Ws1.Range("D:D,J:J,N:N")).Interior.Color = vbGreen
            Else
               Intersect(cl.EntireRow, Ws1.Range("D:D,J:J,N:N")).Interior.Color = vbRed
            End If
         [COLOR=#0000ff]Else
            Intersect(cl.EntireRow, Ws1.Range("D:D,J:J,N:N")).Interior.Color = vbRed[/COLOR]
         End If
      Next cl
   End With
End Sub

This will colour D,J & N either red or green.
If the value in cols A:B on sheet1 should not be red if they do not exist on sheet2 then remove the code in blue

 

[jakobt]

Multi gracias Working excellently.