Excel 2010 VBA alternate row color on changing ran

2019-09-20 18:45发布

In my Excel worksheet I need to apply alternate colors on a specific range that will always start in A5 and end in column X, however the number of lines will change each time the report is ran.

At the end of the first range I need to move down 2 rows and apply alternate row color to the 4 rows.

I found the following code on stackoverflow but so far I can only get row A5 to highlight.

Sub AlternateRowColors()
    Dim LastRow As Long

        'LastRow = Range("A1").End(xlDown) 'Row From original code

    'Find the last used row in a Column: column A in this example
    'Dim LastRow As Long
    With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

End With

For Each Cell In Range("A5:x" & LastRow) ''change range accordingly
    If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
        Cell.Interior.ColorIndex = 15 ''color to preference
    Else
        Cell.Interior.ColorIndex = xlNone ''color to preference or remove
    End If
Next Cell

End Sub

I have been trying to figure this out for two days now, any help will be greatly appreciated.

1条回答
爷的心禁止访问
2楼-- · 2019-09-20 19:10

I'm not sure I completely understand your problem, however it sounds as though it's to do with an inaccurate LastRow. Try this method instead. I've commented out your current LastRow method and entered a new one. If you want the absolute last row in your sheet, regardless of which column has the last item of data, then this will help you:

Sub AlternateRowColors()
    Dim LastRow As Long

    With ActiveSheet
        'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    End With

For Each Cell In Range("A5:x" & LastRow) ''change range accordingly
    If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
        Cell.Interior.ColorIndex = 15 ''color to preference
    Else
        Cell.Interior.ColorIndex = xlNone ''color to preference or remove
    End If
Next Cell
End Sub

Additional edit: You asked about stopping the highlight 8 rows before the LastRow. We could change the value of the LastRow after establishing it. Simply add the following two lines in the middle of the code (after the End With, and before the For Each loop):

LastRow = LastRow - 8
If LastRow < 5 Then LastRow = 5

The first line changes the LastRow variable; the second line checks if the LastRow value is now less than our intended starting row (row 5). If it is less, then it changes it to 5, as 5 is the minimum (starts on row 5, ends on row 5 or later).


Additional edit 2: You say that the row below the "LastRow" is a merged row and would not be highlighted, but the next 4 rows will have a different highlight color... try out the code below. The main addition is the last line of code which colours the single range, the four lines as you describe. However to use this line of code I had to reference the genuine LastRow, and so I had to change the middle of the script - it now creates a new 'LastRowNew' for the purpose of colouring the alternate rows, as it did before.

Hopefully this is what you need now; but if anything isn't exactly how you need it, you should be able to tweak it to your requirements. Hope this helps!

Sub AlternateRowColors()
    Dim LastRow As Long

    With ActiveSheet
        'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    End With

    LastRowNew = LastRow - 8
    If LastRowNew < 5 Then LastRowNew = 5

    For Each Cell In Range("A5:x" & LastRowNew) ''change range accordingly
        If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
            Cell.Interior.ColorIndex = 15 ''color to preference
        Else
            Cell.Interior.ColorIndex = xlNone ''color to preference or remove
        End If
    Next Cell

    Range("A" & (LastRow + 2), Range("X" & (LastRow + 5))).Interior.ColorIndex = 45

End Sub
查看更多
登录 后发表回答