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

RobBan67

New Member
Joined
Jan 23, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
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.

Project List.png


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.

Data.jpg

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!

VBA Code:
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
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
Set AllRows = MyRange.Rows(5)
For i = 1 To AllRows.Rows.Count Step 4
Set RowSelect = MyRange.Rows(i))
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,883
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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
 
Solution

RobBan67

New Member
Joined
Jan 23, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,883
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

You're welcome & thanks for the feedback.
 

RobBan67

New Member
Joined
Jan 23, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,883
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

RobBan67

New Member
Joined
Jan 23, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Try
VBA Code:
         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?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,883
Office Version
  1. 365
Platform
  1. Windows
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 ""
 

Watch MrExcel Video

Forum statistics

Threads
1,130,172
Messages
5,640,584
Members
417,152
Latest member
DayTimeSeby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top