Search color than search value than copy both rows

[emukiss10]

Hello Guys!

A little tricky VBA request.

first part of code looks like this: (if cells have interior color diff than white add "NO" to selected row to column L)

 Dim CColour As Long
 Dim e As Long


    CColour = RGB(255, 255, 255)
    
    For e = 2 To Cells(Rows.count, "A").End(xlUp).row
        If Cells(e, "E").Interior.Color <> CColour Then
[B]        Cells(e, "L") = "NO"[/B]
        End If
    Next e

I would like to delete that Bold statement and add complicated one.

if color <> white then

take number from cell A2 Sheets(2) (if in row 2 col E color do not match ofc),
search it in cell column A Sheets(6)
and if found copy entire row Sheets(6) to Sheets(7) (Sheets(7) has headers so start from row 2)
and the row A2 Sheets(2) to next row Sheets(7)
- add one blank row (with no data for estetics) and go on till end of data in column A Sheets(2)





--------------------------------
Mayby this code can be of some use (copyright FLUFF)

   Dim Cl As Range
   Dim rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Sheets(1).Range("F2", Sheets(1).Range("F" & Rows.count).End(xlUp))
         If Not .Exists(Cl.Value) Then .Add Cl.Value, Nothing
      Next Cl
      For Each Cl In Sheets(2).Range("E2", Sheets(2).Range("E" & Rows.count).End(xlUp))
         If Not .Exists(Cl.Value) Then
            If rng Is Nothing Then
               Set rng = Cl
            Else
               Set rng = Union(rng, Cl)
            End If
         End If
      Next Cl
   End With
   If Not rng Is Nothing Then rng.EntireRow.Delete

Best Regards
W.

 

[emukiss10]

Perfect!

 

[Fluff]

Glad to help & thanks for the feedback