highlighting specific cells using VBA?

[ESACAWIP]

Hi, I was wondering if anyone can help me out.

I am looking for a vba solution where I have the ability to tell excel to:

-identify a starting cell (D1)
-at this point, begin highlighting a certain number of columns a random color (in this case, highlight every 2 columns and random color)
-end at cell (K4)


Can someone help me in creating such a vba code? Thank you very much!

 

[bebo021999]

What range of random color? With random color (colorindex= 1 to 56) some time columns filled with dark color.
In this code, random color from 1 to 56.

Option Explicit
Sub color()
Dim lr&, lc&, j&
lr = Cells(Rows.Count, "A").End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Randomize
For j = 4 To lc - 1 Step 2
    Cells(1, j).Resize(lr, 2).Interior.ColorIndex = Int(Rnd * 56) + 1
Next
End Sub

 

[Peter_SSs]

This is quite similar to @bebo021999's but has a check to ensure that you do not end up with 4 or more consecutive columns the same colour.
It also adjusts the font colour so that it should always be fairly easy to read on whatever background cell colour is chosen.

Sub Colour_Column_Pairs()
  Dim c As Long, lr As Long, OldClr As Long, NewClr As Long
  
  Const ColsToColour As String = "D:K"  '<- Set your column range here
  
  Randomize
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(xlUp).Row
  With Range(ColsToColour).Resize(lr)
    For c = 1 To .Columns.Count Step 2
      NewClr = Int(Rnd * 56) + 1
      Do Until NewClr <> OldClr
        NewClr = Int(Rnd * 56) + 1
      Loop
      With .Columns(c).Resize(, 2)
        .Interior.ColorIndex = NewClr
        .Font.Color = vbBlack
        Select Case NewClr
          Case 1, 3, 5, 9 To 14, 16, 18, 21, 23, 25, 29 To 32, 46 To 56
            .Font.Color = vbWhite
        End Select
      End With
      OldClr = NewClr
    Next
  End With
  Application.ScreenUpdating = True
End Sub

 

[ESACAWIP]

VBA Code:

VBA Code:

Hi thank you so much for the response! I was playing around with both of these vba codes and having some trouble figuring out how to change the number of columns that are highlighted. In both examples, 2 columns are highlighted / repeated. How would you change this number to e.g. 10 columns instead?

Thank you!

 

[bebo021999]

Hi thank you so much for the response! I was playing around with both of these vba codes and having some trouble figuring out how to change the number of columns that are highlighted. In both examples, 2 columns are highlighted / repeated. How would you change this number to e.g. 10 columns instead?

Thank you!

My post in #2 with:
lc = Cells(1, Columns.Count).End(xlToLeft).Column
to define last column (with header in row 1).
Make sure your actua data columns have header then it should works.

 

[Peter_SSs]

.. 2 columns are highlighted / repeated. How would you change this number to e.g. 10 columns instead?

Try this version. I have assumed that you would ensure that the number of columns in ColsToColour was a multiple of ColGroup.

Sub Colour_Column_Groups()
  Dim c As Long, lr As Long, OldClr As Long, NewClr As Long
  
  Const ColsToColour As String = "D:R"  '<- Set your column range here
  Const ColGroup As Long = 5           '<- How many columns in each group
  
  Randomize
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(xlUp).Row
  With Range(ColsToColour).Resize(lr)
    For c = 1 To .Columns.Count Step ColGroup
      NewClr = Int(Rnd * 56) + 1
      Do Until NewClr <> OldClr
        NewClr = Int(Rnd * 56) + 1
      Loop
      With .Columns(c).Resize(, ColGroup)
        .Interior.ColorIndex = NewClr
        .Font.Color = vbBlack
        Select Case NewClr
          Case 1, 3, 5, 9 To 14, 16, 18, 21, 23, 25, 29 To 32, 46 To 56
            .Font.Color = vbWhite
        End Select
      End With
      OldClr = NewClr
    Next
  End With
  Application

 

[ESACAWIP]

works great, thank you so much to the both of you!

 

[Peter_SSs]

You're welcome. Glad we could help. Thanks for the follow-up.