Only color every third row based on a value in another sheet.

[RobBan67]

Hello everyone.
First of all, I’m a VBA rookie, so please bare with me
This is what I’m trying to do.
I have one sheet (Project List) with a table (Table1) that looks like this.

What I’m trying to achieve is to set a specific background color to every third row
based on the color Index in another Sheet called (Data), that l looks like this.

So, I want the script to search for the “customer” name in the sheet Data and return the right color for each Customer to the Project List color the with the right color.

I found this code online that I tried to modify to fit my needs, but without succsess.
Right now the script only color the first two “Customers” but color the both of them with the color of the first customer (Walker & Son).

I hope I can get some help and guidance to make this work, because this is beyond my knowledge ?
Thanks!

Sub Color_Project()

Dim MyRange As Range

Dim RowSelect As Range

Dim SeekValue As Range

Dim ReturnValue As Range

Dim i As Integer


Set SeekValue = Sheets("Project List").Range("Table1[Customer]")

Set ReturnValue = Sheets("Data").Range("Data[Customer]")



Set MyRange = Sheets("Project List").Range("Table1")

Set RowSelect = MyRange.Rows(5)



For i = 1 To RowSelect.Rows.Count Step 4

Set RowSelect = Union(RowSelect, MyRange.Rows(i))



For Each Datacell In SeekValue

For Each ColorValueCell In ReturnValue



If Datacell.Value = ColorValueCell.Value Then

Set ColorIndexCell = Sheets("Data").Range("C" & ColorValueCell.Row)

RowSelect.Interior.ColorIndex = ColorIndexCell.Value


End If

Next

Next

Next

End Sub

 

[mart37]

Set AllRows = MyRange.Rows(5)
For i = 1 To AllRows.Rows.Count Step 4
Set RowSelect = MyRange.Rows(i))

 

[Fluff]

How about

Sub RobBan()
   Dim i As Long
   Dim Fnd As Range, CustRng As Range
   
   Set CustRng = Sheets("Data").ListObjects("Data").ListColumns("Customer").DataBodyRange
   
   With Sheets("Project List").ListObjects("Table1")
      For i = 1 To .DataBodyRange.Rows.Count Step 4
         Set Fnd = CustRng.Find(.ListColumns("Customer").DataBodyRange(i), , , xlWhole, , , False, , False)
         If Not Fnd Is Nothing Then .DataBodyRange.Rows(i).Interior.ColorIndex = Fnd.Offset(, 1)
      Next i
   End With
End Sub

 

[RobBan67]

How about

Sub RobBan()
   Dim i As Long
   Dim Fnd As Range, CustRng As Range
  
   Set CustRng = Sheets("Data").ListObjects("Data").ListColumns("Customer").DataBodyRange
  
   With Sheets("Project List").ListObjects("Table1")
      For i = 1 To .DataBodyRange.Rows.Count Step 4
         Set Fnd = CustRng.Find(.ListColumns("Customer").DataBodyRange(i), , , xlWhole, , , False, , False)
         If Not Fnd Is Nothing Then .DataBodyRange.Rows(i).Interior.ColorIndex = Fnd.Offset(, 1)
      Next i
   End With
End Sub

Thanks Fluff!
Works like a charm ? ?

 

[Fluff]

You're welcome & thanks for the feedback.

 

[RobBan67]

How about

Sub RobBan()
   Dim i As Long
   Dim Fnd As Range, CustRng As Range
  
   Set CustRng = Sheets("Data").ListObjects("Data").ListColumns("Customer").DataBodyRange
  
   With Sheets("Project List").ListObjects("Table1")
      For i = 1 To .DataBodyRange.Rows.Count Step 4
         Set Fnd = CustRng.Find(.ListColumns("Customer").DataBodyRange(i), , , xlWhole, , , False, , False)
         If Not Fnd Is Nothing Then .DataBodyRange.Rows(i).Interior.ColorIndex = Fnd.Offset(, 1)
      Next i
   End With
End Sub

One more question for you Fluff ?
Would it be possible to make the script not to color the empty cells in each row?

Thanks again!

 

[Fluff]

Try

         If Not Fnd Is Nothing Then .DataBodyRange.Rows(i).SpecialCells(xlConstants).Interior.ColorIndex = Fnd.Offset(, 1)

 

[RobBan67]

Try

         If Not Fnd Is Nothing Then .DataBodyRange.Rows(i).SpecialCells(xlConstants).Interior.ColorIndex = Fnd.Offset(, 1)

Unfortunate that didn’t work due to that the “Hours spent” column has a sum formula in it

Any other idees?

 

[RobBan67]

Unfortunate that didn’t work due to that the “Hours spent” column has a sum formula in it

Any other idees?

 

[Fluff]

In that case you are probably better off leaving the entire row coloured & then using conditional formatting to change the fill colour if it's ""