macro to highlight rows

[tandrea]

What would the VB language be for:

I want to write a macro to highlight only rows containing data, however, the numbers of rows change each time.

I am always starting on cell G2 for example and sometimes highlight down to H16 or it could be down as far as H20600.

Please help!

 

[Joe Was]

This code will color any cell you enter data in, if you empty data it will un-color the cell background. It does not work on any cell with data pre-loaded!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim rng As Range
'Make all calls with data entered colored.
'Makes cells with data removed un-colored.
'Load from ThisWorkBook Module.
With Application
.EnableEvents = False
For Each rng In Source
If rng.Value<> "" Then
rng.Interior.ColorIndex = 6
Else
rng.Interior.ColorIndex = xlNone
End If
Next
.EnableEvents = True
End With
End Sub

You can also use "Conditional Formatting." Block the range you want it to work on, then use "Cell Value Is" "Not Equal To" enter this in formula box: =""

This code does the same thing only by different code. Here you can set the range it works on and set different case conditions. You can set as many colors or conditions as you wish, just by adding additional case statements to the chain.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myColor As Integer
If Not Intersect(Target, Range("A1:AA10")) Is Nothing Then
Select Case Target
Case Is<> ""
myColor = 6
Case Is = ""
myColor = 0
Case Else
'Whatever
End Select
Target.Interior.ColorIndex = myColor
End If

End Sub


Hope this helps. JSW
This message was edited by Joe Was on 2002-09-25 14:12

 

[rikrak]

Hi,

As Joe Was mentioned: "It does not work on any cell with data pre-loaded!"

You can use this code to color rows already containing data.

<pre>
Sub colorOnce()
Dim found, rngUnion As Range
'
'color all rows containing data
'
Application.EnableEvents = False

'remove all colors
Cells.EntireRow.Interior.ColorIndex = xlNone

Set found = Cells.Find("*")
If Not found Is Nothing Then
FirstAddress = found.Address
Set rngUnion = found
Do
Set found = Cells.FindNext(After:=found)
If found.Address = FirstAddress Then Exit Do
Set rngUnion = union(found, rngUnion)
Loop

' add color
rngUnion.EntireRow.Interior.ColorIndex = 6

End If
Set found = Nothing
Set rngUnion = Nothing

Application.EnableEvents = True

End Sub
</pre>

 

[Joe Was]

This will color any cell with data. If run again any cells changed to blank will be un-colored and new cells with values or data colored.

As you can see there are many ways to do this. JSW

Sub myColor()
'Color all cells with data, un-color blank cells, each time run.
Worksheets("Sheet1").Select
'In this range, color.
Set myRange = Range("A1:H3")
For Each myObject In myRange
If myObject.Value = "" Then myObject.Interior.ColorIndex = 0
If myObject.Value <> "" Then myObject.Interior.ColorIndex = 36
Next
End Sub

 

[Jack in the UK]

Hi Joe

Just for the gain of the original poster and no other reason not that ive tested this, bvut should work, use one of Joes codes and copy the spend data cell if you decide you want it coloured anc paste back in the SAME cell this will fool VBA to say ermm and colour it (it hope !!! well works ok on all my code that are varied on this theame so fell will work)

HTH

Jack