Changing Cell Color based upon value on another worksheet

[DPelletier]

I need help cell coloring based upon matching data on 2 sheets.

'Sheet1' - Data Dump
'Sheet2' - New Formatting

'Sheet1' column AD = "No" then find value on same row but in Column B
Then search on 'Sheet2' for that value in Column B. If found, color
the field in the row above it Red (Color.Index = 3)

I need to check each row of column AD on 'Sheet1' for value = "No" and
search all fields on 'Sheet2' for the value in Column B of same row.
The colored cell on 'Sheet2' will always in the the same column but 1
row up.

Thank you for any assistance you can provide.

Dwayne P.

 

[JLGWhiz]

If I understood the parameters correctly, this should work. You can rename
the sheets to suit in the Set statements.

Sub colorNo()
Dim sh1 As Worksheet, sh2 As Worksheet, fStr As Variant
Dim lr1 As Long, rng As Range, fRng As Range
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
lr1 = sh1.Cells(Rows.Count, "AD").End(xlUp).Row

Set rng = sh1.Range("AD2:AD" & lr1)
For Each c In rng
If c.Value = "No" Then
fStr = sh1.Range("B" & c.Row).Value
With sh2
Set fRng = .UsedRange.Find(fStr, LookIn:=xlValues,
LookAt:=xlWhole)
If Not fRng Is Nothing Then
fAddr = fRng.Address
Do
fRng.Offset(-1).Interior.ColorIndex = 3

Set fRng = .UsedRange.FindNext(fRng)

Loop While Not fRng Is Nothing And fRng.Address <> fAddr
End If
End With
End If
Next
End Sub

 

[DPelletier]

If I understood the parameters correctly, this should work.  You can rename
the sheets to suit in the Set statements.

Sub colorNo()
   Dim sh1 As Worksheet, sh2 As Worksheet, fStr As Variant
   Dim lr1 As Long, rng As Range, fRng As Range
   Set sh1 = Sheets("Sheet1")
   Set sh2 = Sheets("Sheet2")
   lr1 = sh1.Cells(Rows.Count, "AD").End(xlUp).Row

   Set rng = sh1.Range("AD2:AD" & lr1)
      For Each c In rng
         If c.Value = "No" Then
           fStr = sh1.Range("B" & c.Row).Value
           With sh2
           Set fRng = .UsedRange.Find(fStr, LookIn:=xlValues,
LookAt:=xlWhole)
              If Not fRng Is Nothing Then
                 fAddr = fRng.Address
                    Do
                        fRng.Offset(-1).Interior.ColorIndex = 3

                        Set fRng = .UsedRange.FindNext(fRng)

                    Loop While Not fRng Is Nothing And fRng.Address <> fAddr
               End If
               End With
          End If
       Next
End Sub

Works like a charm. Thank you for your time. I could not get the
find value to work before.