VBA Colour to rows

bobhc · Aug 2, 2012

Good evening all

Running this code to colour every other row

When I run this code nothing happens, but I was under the impression that I had set the “ActiveCell.Value” to nothing <> ””

Sub ColorEverySecondRow()

Const Grey = 15

Range("A2").EntireRow.Select

Do While ActiveCell.Value <> ""

Selection.Interior.ColorIndex = Grey

ActiveCell.Offset(2,0).EntireRow.Select

Loop

End Sub

But when I change <>""to<>” “~(a space between “”) the code runs??

………….but Excel hangs at around 9500 is this down to the system or Excel

bobhc · Aug 2, 2012

Realised my mistake and I changed the code to this

Sub ColorEverySecondRow()

Const Grey = 15

Range("A2").EntireRow.Select

Do While ActiveCell.Value = ""

Selection.Interior.ColorIndex = Grey

ActiveCell.Offset(2,0).EntireRow.Select

Loop

End Sub

.......but still hangs after a few thousand rows

SirJB7 · Aug 2, 2012

Hi, b(ut)ob(ut)hc!

The link:

https://dl.dropbox.com/u/60558749/VBA%20Colour%20to%20rows%20%28for%20bobhc%20at%20chandoo.org%29.xlsm

Three macros:

1st., yours, using Select and using ScreenUpdating: 13'51"

2nd., yours, using Select and don't using ScreenUpdating: 3'56"

3rd., mine, don't using .Select and don't using ScreenUpdating: 0'32"

All three over 1048576 rows.

Conclusion:

- try to avoid leaving standard (on) ScreenUpdating, turn it off at start and on at end

- try to avoid using Select, unless you want to actually select a cell or a range, otherwise use referencing instead of selecting

ScreenUpdating No vs. Yes: 3.5 X

Select Yes vs. No: 7.5 X

Overall: 26 X

Regards!

EDIT: BTW, the first code is right too, it worked for me at least.

bobhc · Aug 3, 2012

Good day SirJB7

Many thanks for your help......but I am having a problem with running the code, when macro runs I get the following

1 Select yes, update yes Select yes, update no Select no, update no

2 19:09:53 19:24:05 19:30:56

3 19:23:44 19:28:01 19:31:28

4 00:13:51 00:03:56 00:00:32

5 100% 28% 4%

6 352% 100% 14%

7 2597% 738% 100%

8

9

10

11

12

13

14

15

16

and then nothing happens, I am not selecting any ranges, I tried to comment out code relating to the above but no joy.

Not sure as to what you mean by "standardScreenUpdating"

SirJB7 · Aug 3, 2012

Hi, b(out)ob(ut)hc!

Good afternoon, old dog.

If you see the same figures as in my original file, it means that the macros (any of the three) are not running, as the first thing they do is set B2 (or C2 or D2) cells to Now() and clear B3 (or C3 or D3); then they run and the last thing they do is to set B3 (or C3 or D3) to Now(), remaining unchanged formulas from B4:B7 (or C4:C7 or D4:D7).

Please download the file again from same link. I changed colors from grey (15) in 1st, to yellow (6) in 2nd, and multicolor from (0-15 +2) in 3rd.

So try running the three again and check if they work. I added a DoEvents instruction to all them to let you pause (Ctrl-Break) execution, if needed.

Observations:

1st macro: it can be paused, terminated without any issue.

2nd macro: if paused or terminated you won't see nothing as ScreenUpdating is set to False at the beginning, so you must type in the Immediate window pane " Application.ScreenUpdating = True" (unquoted)

3rd macro: same as above

I uploaded the file without any color, so running each macro will let you know if it's properly executing.

Just advise if any issue.

Regards!

bobhc · Aug 3, 2012

Good evening SirJB7

More studying.......but with my thanks

Luke M · Aug 3, 2012

Can't see SirJB7's code due to CAFFML, but here's my go at writing a short macro to highlight every other used row.

[pre]

Code:

Sub ColorRows()
Dim LastRow As Integer
LastRow = Range(&#34;A65536&#34;).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To LastRow Step 2
Rows(i).EntireRow.Interior.ColorIndex = 16
Next
Application.ScreenUpdating = True
End Sub

[/pre]

SirJB7 · Aug 3, 2012

@Luke M

Hi!

Sorry, I forgot your absolutely useful trick of CASFFML feature

Column A: =ROW()

$B$4 =IF(OR(ISBLANK(B2),ISBLANK(B3)),"",B3-B2)

$C$4 =IF(OR(ISBLANK(C2),ISBLANK(C3)),"",C3-C2)

$D$4 =IF(OR(ISBLANK(D2),ISBLANK(D3)),"",D3-D2)

$B$5 =IFERROR(B4/B4,"")

$C$5 =IFERROR(C4/B4,"")

$D$5 =IFERROR(D4/B4,"")

$B$6 =IFERROR(B4/C4,"")

$C$6 =IFERROR(C4/C4,"")

$D$6 =IFERROR(D4/C4,"")

Here's the code:

-----

[pre]

Code:

Option Explicit

Sub ColorEverySecondRow1()
Const Grey = 15
Range(&#34;B1&#34;).Value = &#34;Select yes, update yes&#34;
Range(&#34;B2&#34;).Value = Now
Range(&#34;B3&#34;).Value = &#34;&#34;
Range(&#34;A2&#34;).EntireRow.Select
Do While ActiveCell.Value &#60;&#62; &#34;&#34;
Selection.Interior.ColorIndex = Grey
If ActiveCell.Row &#60; 1048576 Then
ActiveCell.Offset(2, 0).EntireRow.Select
Else
Exit Do
End If
DoEvents
Loop
Debug.Print Now()
Beep
Range(&#34;A1&#34;).Select
Range(&#34;B3&#34;).Value = Now
Beep
End Sub

Sub ColorEverySecondRow2()
Const Yellow = 6
Application.ScreenUpdating = False
Range(&#34;C1&#34;).Value = &#34;Select yes, update no&#34;
Range(&#34;C2&#34;).Value = Now
Range(&#34;C3&#34;).Value = &#34;&#34;
Range(&#34;A2&#34;).EntireRow.Select
Do While ActiveCell.Value &#60;&#62; &#34;&#34;
Selection.Interior.ColorIndex = Yellow
If ActiveCell.Row &#60; 1048576 Then
ActiveCell.Offset(2, 0).EntireRow.Select
Else
Exit Do
End If
DoEvents
Loop
Range(&#34;A1&#34;).Select
Range(&#34;C3&#34;).Value = Now
Application.ScreenUpdating = True
Beep
End Sub

Sub ColorEverySecondRow3()
&#39; constants
&#39;Const Grey = 15 (Multicolor 0 To 15)
&#39; declarations
Dim I As Long
&#39; start
Application.ScreenUpdating = False
Cells(1, 4).Value = &#34;Select no, update no&#34;
Cells(2, 4).Value = Now
Cells(3, 4).Value = &#34;&#34;
&#39; process
&#39;Range(&#34;A2&#34;).EntireRow.Select
I = 2
&#39;Do While ActiveCell.Value &#60;&#62; &#34;&#34;
Do While Cells(I, 1).Value &#60;&#62; &#34;&#34;
&#39;Selection.Interior.ColorIndex = Grey
Cells(I, 1).EntireRow.Interior.ColorIndex = ((I / 2 + 2) Mod 16) &#39;+2 to avoid black and white on first 4 time rows
&#39;ActiveCell.Offset(2, 0).EntireRow.Select
I = I + 2
If I &#62; 1048576 Then Exit Do
DoEvents
Loop
&#39; end
Cells(3, 4).Value = Now
Application.ScreenUpdating = True
Beep
End Sub

[/pre]
-----

Regards!

@b(ut)ob(ut)hc

Hi!

May I share your code with Luke M? I think you wouldn't mind, would you?

Regards!

bobhc · Aug 3, 2012

Luke M Good evening or in your case after noon.

Tried the code steps through ok but does not alter any rows

SirJB7 · Aug 3, 2012

Hi, b(out)ob(ut)hc!

Have you run the 3 macros from the new updated file?

Let start from the 1st, you didn't see the even rows getting grey?

If yes, run 2nd. and wait 'til it ends and then same with 3rd, else, there's something wrong with your Excel options, I guess.

Regards!

Luke M · Aug 3, 2012

When you say the code steps through, does that mean it just runs okay, or you could actually see it going through the loops and running the step to color the row, but the row doesn't actually get colored?

Also, I realize now that you may be using formulas in column A to generate a "", wheras my code is only detecting truly blank cells.

Small modification:

[pre]

Code:

Sub ColorRows()
Dim LastRow As Integer
LastRow = Range(&#34;A65536&#34;).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To LastRow Step 2
If Cells(i, &#34;A&#34;).Value = &#34;&#34; Then Exit For
Rows(i).EntireRow.Interior.ColorIndex = 16
Next
Application.ScreenUpdating = True
End Sub

[/pre]

Luke M · Aug 3, 2012

Any conditional formatting we should be aware of? Have you somehow change the color assignments so that colorindex #15 is white?

SirJB7 · Aug 3, 2012

Hi, b(out)ob(ut)hc!

I slightly changed the code to as follows, because Luke M assumed nobody will run that macro on more than 65535 rows (with 65536 it doesn't work neither because with the ".End(xlUp)" it gets first row as are all filled).

To be incorporated into my sample file, I added declaration for I variable too. Constant klLimit may be set to any desired value.

-----

[pre]

Code:

Sub ColorRows()
Const klLimit As Long = 1048576 &#39;65536
Dim LastRow As Long
Dim I As Long
If Range(&#34;A&#34; & klLimit).Value &#60;&#62; &#34;&#34; Then
LastRow = klLimit
Else
LastRow = Range(&#34;A&#34; & klLimit).End(xlUp).Row
End If
Application.ScreenUpdating = False
For I = 2 To LastRow Step 2
Rows(I).EntireRow.Interior.ColorIndex = 16
Next
Application.ScreenUpdating = True
End Sub

[/pre]
-----

Regards!

@Luke M

Hi!

Check this comment, I started it before yours last 2. I think the problem is that the creator guy used the whole column A

... not only 65536 but 1048576 rows... :=)

Regards!

sparcle · Aug 3, 2012

Hi bobhc,

Can i know where the problem occur, because i already use this code & it run fine.

SirJB7 · Aug 3, 2012

Hi, all!

Incorporated Luke M's macro, as 4th, my customization, as 5th. Reuploaded file.

The link:

https://dl.dropbox.com/u/60558749/VBA%20Colour%20to%20rows%20%28for%20bobhc%20at%20chandoo.org%29.xlsm

Regards!

Luke M · Aug 3, 2012

@SirJB7

What is this craziness you speak of, there are no numbers larger than 65536! =P

Fine, to accomodate the "impossible" and to make better use of what's going on in col A:

[pre]

Code:

Sub ColorRows()
Dim i As Long
Application.ScreenUpdating = False
i = 2 &#39;Starting row

Do Until Cells(i, &#34;A&#34;).Value = &#34;&#34; Or i &#62; 1048576
Rows(i).EntireRow.Interior.ColorIndex = 16
i = i + 2
Loop
Application.ScreenUpdating = True
End Sub

[/pre]

bobhc · Aug 3, 2012

Luke M

By step through I meant in the "step into2 VBE. steps through but jumps this line

Rows(i).EntireRow.Interior.ColorIndex = 16

straight to this line of code

Application.ScreenUpdating = True

Sub ColorRows()

Dim LastRow As Integer

Dim i As Double

LastRow = Range("A65536").End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To LastRow Step 2

Rows(i).EntireRow.Interior.ColorIndex = 16

Next

Application.ScreenUpdating = True

End Sub

SirJB7 · Aug 3, 2012

@Luke M

Hi!

Checked my updated comment?

http://chandoo.org/forums/topic/vba-colour-to-rows#post-35527

Regards!

SirJB7 · Aug 3, 2012

@SirJB7

Hi, myself!

So long...

I love using 2^20 rows for testing

Regards!

PS: originally intended for benchmarking... and bullet proof test ;-o)

sparcle · Aug 3, 2012

Here is sample it may help.

http://www.2shared.com/file/Tz4NiSPb/colr.html

bobhc · Aug 3, 2012

sparkle good day

This is more or less where I started, the code runs until it finds a row that is empty and then stops, what I was trying to do was colour the rows before data was entered,........but I think to do this with a full sheet and small code will not work.

sparcle · Aug 3, 2012

Hello bobhc,

is it ok to change the row color after enter anything to row.

If not then how many cells you want to color before data was entered.

SirJB7 · Aug 3, 2012

Hi, b(out)ob(ut)hc!

After all this comments you and Luke M confused me, as always, so here's my doubt.

Could you download and run successfully the macros 1,2,3,5? If not, please detail each issue.

Regards!

sparcle · Aug 3, 2012

Hello SirJB7,

I uploaded a file could you check it.

http://www.2shared.com/file/3VPAry2d/colr.html

SirJB7 · Aug 3, 2012

Hi, sparcle!

It does the same as b(ut)ob(ut)hc's first macro, except that you now changed it to be triggered by sheet change event. It works fine. If you have any other concerns about that macro, I suggest you to read carefully all this topic to fully understand the evolution of the 1st macro from the poster to my 2nd and 3rd versions.

Regards!

VBA Colour to rows

Excel Ninja

Excel Ninja

Excel Rōnin

Excel Ninja

Excel Rōnin

Excel Ninja

Excel Ninja

Excel Rōnin

Excel Ninja

Excel Rōnin

Excel Ninja

Excel Ninja

Excel Rōnin

New Member

Excel Rōnin

Excel Ninja

Excel Ninja

Excel Rōnin

Excel Rōnin

New Member

Excel Ninja

New Member

Excel Rōnin

New Member

Excel Rōnin