Highlighting every other row a different color with vba

[Spreadlover]

Hello,

I have a working macro to highlight whatever I select one color. I need it to be able to color every other row in my selection.....Sometimes I just select a grid and sometimes I select entire columns. I would then like to select a second color to start at the second row of my selection.

Any help would be greatly appreciated.

Thank you.

[HaHoBe]

Hi, Spreadlover,

itīs clear to you that any exisiting colour should be saved and restored later on?

Sub EF956049()
Dim lngCounter As Long
Dim rngRow As Range
Const clngFIRST As Long = 42
Const clngSECOND As Long = 6

For lngCounter = 1 To Selection.Rows.Count
  Select Case lngCounter Mod 2
    Case 0
      Selection.Rows(lngCounter).Interior.ColorIndex = clngSECOND
    Case 1
      Selection.Rows(lngCounter).Interior.ColorIndex = clngFIRST
  End Select
Next lngCounter
End Sub

I have a working macro to highlight whatever I select one color.

Maybe you should have enclosed that macro here.

Ciao,
Holger

[Spreadlover]

I apologize, this is the book I was working with. I see I did not post it.

[Spreadlover]

This was the code I had.

 Sub HiglightandBorders()
'
'   Macro1 Macro
'

'   Add Highlight

    
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

'   Add Borders
    
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

[HaHoBe]

Hi, Spreadlover,

you could replace the code lines

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

with

Dim lngCounter As Long
Dim rngRow As Range
Const clngFIRST As Long = 42
Const clngSECOND As Long = 6

For lngCounter = 1 To Selection.Rows.Count
  Select Case lngCounter Mod 2
    Case 0
      Selection.Rows(lngCounter).Interior.ColorIndex = clngSECOND
    Case 1
      Selection.Rows(lngCounter).Interior.ColorIndex = clngFIRST
  End Select
Next lngCounter

and leave the rest of the code as it is.

Ciao,
Holger

[Spreadlover]

Thank you for your response Holger. I apologize for the delay in my response. I haven't had a chance to take a peek at this until just now. The code seems to work properly on every test, except when I select columns A thru H......It stops excel from working and seems to crash it.

Is there a way to speed up the calculations in the coding to keep excel from crashing or should I just try to make smaller selections at a time?

Thanks,

Spreadlover.

[Spreadlover]

Please disregard the last question. I see that when I stopped the code it had highlighted over 1,000,000 rows already. That is far more then I will ever need. I will just have to be a little more selective on choice or I will put a counter on it to stop at 5,000. Thank you again.

[Spreadlover]

I have a question on whether or not I can easily use the rgb scale on color for this code. I have tried playing with it, but I have had no luck. The colors I am using on my spreadsheet are not showing up on the single number scale.

[HaHoBe]

Hi, Spreadlover,

adjust the colours as wanted:

Dim lngCounter As Long

For lngCounter = 1 To Selection.Rows.Count
  Select Case lngCounter Mod 2
    Case 0
      Selection.Rows(lngCounter).Interior.Color = RGB(0, 80, 207)
    Case 1
      Selection.Rows(lngCounter).Interior.Color = RGB(255, 100, 87)
  End Select
Next lngCounter

Ciao,
Holger

[Spreadlover]

This works perfectly and it is very easy to match the color scheme. Each page has a bit of a varying color scheme, so the same macro with different names and a slightly different color code can be easily used to keep each sheet easily updated as new rows are added. Every time a new product is added a new row needs to be added and this works perfectly. I wanted to stay away from conditional formatting in order to have certain columns stay a specific color as well.

[Spreadlover]

The original code seen above was written and works fine in Excel 2007 and up I believe, but I had trouble with the code on an older version at work running Excel 2003. I had to change the code to the following in order for it to give me the same results. This is just an update and a reference for anyone who might be looking for something similar.

'   Add Highlight every other row

    
    
    Dim lngCounter As Long

    For lngCounter = 1 To Selection.Rows.Count
        Select Case lngCounter Mod 2
            Case 0
        Selection.Rows(lngCounter).Interior.Color = RGB(155, 204, 255)
            Case 1
        Selection.Rows(lngCounter).Interior.Color = RGB(0, 255, 0)
    End Select
    
    Next lngCounter
      
    
'   Add Borders
    
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
End Sub

[tuongtu3]

I like your code and I also want to add the below lines and put code in WorkSheet so I don't have to run a Macro:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Target Is Nothing Then
......your code here

Regards,
tt3