highlights every other row

pedy

Board Regular
Joined
Jan 6, 2006
Messages
217
Hi,

I have this bit of code that highlights every other row. I would like to modify it so that it doesn't highlight the entire rows but instead stops at the column of whichever cell contains data.

For instance if I’m using a block of cells such as A1 to C5 it would highlight A2-B2-C2 & A4-B4-C4 only. Later on if I insert data in D3 it would now highlight A2-B2-C2-D2 & A4-B4-C4-D4. Anytime that data would be inserted into a new column all row highlight would now adapt to the new length of the table.

Here’s the code:

Sub ShadeEverySecondRow()
Dim lRow As Long
lRow = 0
Do
lRow = lRow + 2
If IsEmpty(Cells(lRow, 1)) Then Exit Do
Rows(lRow).Interior.ColorIndex = 15
Loop
End Sub


Any help is appreciated

Pedy
 

Some videos you may like

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,901
Code:
Do
    lRow = lRow + 2
    If IsEmpty(Cells(lRow,1)) Then Exit  Do
    With Rows(lRow)
        Range(.Cells(1,1),.Cells(1,.Columns.Count).End(xlToLeft)).Interior.ColorIndex = 15
    End With
Loop
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

Code:
Sub ShadeEverySecondRow()
Dim lRow As Long, LC As Integer
lRow = 0
Do
    lRow = lRow + 2
    If IsEmpty(Cells(lRow, 1)) Then Exit Do
    LC = Cells(lRow, Columns.Count).End(xlToLeft).Column
    Range(Cells(lRow, 1), Cells(lRow, LC)).Interior.ColorIndex = 15
Loop
End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,

try this
Code:
Option Explicit
 
Sub ShadeEverySecondRow()
Dim lRow As Long
Dim LR As Long
Dim LC As Long
 
    With ActiveSheet.Cells
    LR = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
    LC = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious, False, False).Column
    End With
    
lRow = 0
 
    For lRow = 2 To LR Step 2
    Range(Cells(lRow, 1), Cells(lRow, LC)).Interior.ColorIndex = 15
    Next lRow
 
End Sub
kind regards,
Erik
 

pedy

Board Regular
Joined
Jan 6, 2006
Messages
217

ADVERTISEMENT

Thanks for the quick replies guys!

Erik, if there is only 1 cell in the last column that has data in it, and if this data is removed, how can all the other highlighted rows (that used to end at the last column) be cleared ?

For instance, using the A1 to C5 table example, we have added data in cell D3. Later on it was found that D3 is no longer needed. By removing D3, the highlight would go back to A2-B2-C2 & A4-B4-C4 only.

Thanks again

Pedy
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
you can insert a line to clear the colors
put line this after the "with" line

Code:
    .Interior.ColorIndex = xlNone
 

pedy

Board Regular
Joined
Jan 6, 2006
Messages
217

ADVERTISEMENT

Smashing!

Thanks so much

Pedy
 

pedy

Board Regular
Joined
Jan 6, 2006
Messages
217
Hi again,

I've been trying to add on to the last macro. I wanted to have an automatic BorderAround the whole table but for some reason I'm only getting the top & left borders. Can you help please ?

Here's the whole thing:

Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim lRow As Long
Dim LR As Long
Dim LC As Long

With ActiveSheet.Cells
.Interior.ColorIndex = xlNone

.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone

.BorderAround LineStyle = False

LR = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
LC = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious, False, False).Column
End With

lRow = 0

For lRow = 2 To LR Step 2
Range(Cells(lRow, 1), Cells(lRow, LC)).Interior.ColorIndex = 15

Range(Cells(lRow, 1), Cells(LR)).BorderAround xlEdgeBottom = xlContinuous
Next lRow

End Sub

Pedy
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
You are a member for 3 years. I hope you will learn to use codetags. It's not nice to see code which was nicely indented flowing all over the screen.

delete the line
Code:
Range(Cells(lRow, 1), Cells(LR)).BorderAround xlEdgeBottom = xlContinuous
and add this code before "end sub"
Code:
    With Range(Cells(2, 1), Cells(lRow, LC)).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
As you can see, you can use "borders" without more: that way all borders are put at once.

best regards,
Erik
 

pedy

Board Regular
Joined
Jan 6, 2006
Messages
217
Sorry about the tabs, no offense intended.

That seems to add borders to each cell starting with the first highlighted cell (the first line of the table has no borders).

What I was hoping to do is have a border around the perimeter of the table only and not have any borders inside.

Pedy
 

Watch MrExcel Video

Forum statistics

Threads
1,122,387
Messages
5,595,884
Members
414,029
Latest member
mrwilker

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