Use VBA to format cells

E

emea training 2

Is it possible to use a macro to format Excel?

I have a number of sets of data under headings e.g.

Heading1
Data 1 Data 2 Data 3
Data 1 Data 2 Data 3

Heading2
Data 1 Data 2 Data 3
Data 1 Data 2 Data 3

I want to format the whole heading row only to be a particular (an
different) colour
I could use Conditional Formatting to get 3 different colours but
have approximately 20 different headings that need to be differen
colours.

Also the headings will be in different rows each time the report i
run.

Many thank
 
F

Frank Kabel

Hi
you could process the worksheet_change event and apply
your format based on the
cell values).
The following will color the entry in cell A1:A100 based
on its value:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("A1:A100")) Is Nothing
Then Exit Sub
On Error GoTo CleanUp
Application.EnableEvents = False
With Target
Select Case .Value
Case "Red": .Interior.ColorIndex = 3
Case "Blue": .Interior.ColorIndex = 10
'etc.
End Select
End With
CleanUp:
Application.EnableEvents = True
End Sub
 
W

wammer

I've seen quite a few posts answering how to change colors via macros.
I've been using the formulas as described, however these only seem t
work if I am physically changing the cell (i.e. typing in the value).
If the cell if a formula linked to another cell that generates th
value, then the color does not change. Any way to fix that
 
D

Dave Peterson

I bet you've seen worksheet_change event code.

There's another event you could use that will fire whenever the worksheet is
calculated.

It's called worksheet_calculate.

Here's a small example:

Option Explicit
Private Sub Worksheet_Calculate()

Dim myColorIndex As Long

Select Case LCase(Me.Range("a1").Value)
Case Is = "hi": myColorIndex = 3
Case Is = "bye": myColorIndex = 5
Case Else: myColorIndex = xlNone
End Select
Me.Range("a1").Interior.ColorIndex = myColorIndex

End Sub
 
W

wammer

Thanks a lot for your reply - I now have this, but am getting an erro
on the Select Case line. Do I need something in the Calculat
parentheses. Sorry for the basic questions here.

Private Sub Worksheet_Calculate()

Dim myColorIndex As Long

Select Case LCase(Me.Range("o5:iv2232").Value)
Case Is = "B": myColorIndex = 3
Case Is = "V": myColorIndex = 5
Case Else: myColorIndex = xlNone
End Select
Me.Range("o5:iv2232").Interior.ColorIndex = myColorIndex

End Su
 
D

Dave Peterson

Each cell has a value. A range of cells doesn't.

Option Explicit

Private Sub Worksheet_Calculate()

Dim myColorIndex As Long
Dim myCell As Range
Dim myRng As Range

Set myRng = Me.Range("o5:Iv2232")

For Each myCell In myRng.Cells
Select Case LCase(myCell.Value)
Case Is = "b": myColorIndex = 3
Case Is = "v": myColorIndex = 5
Case Else: myColorIndex = xlNone
End Select
myCell.Interior.ColorIndex = myColorIndex
Next myCell

End Sub

I'd try to limit that range a bit. This could slow down things considerably.

(I'd probably just put it in a regular macro and run it when I wanted!)

And watch your lcase() stuff. lCase = lower case, so you have to check for b,v
(not B,V).
 
W

wammer

Dave -

Thanks. This coded worked perfectly.

I tried to convert it to a regular macro that I could run on its own.
I couldn't get it to work. How can I do it?


Thanks
Cam
 
D

Dave Peterson

First, the code would go in a general module (not behind the worksheet).

Then rename it to something that's memorable (not testme!).

And you could limit your range by looking just within the used range.

Option Explicit

Sub testme()

Dim myColorIndex As Long
Dim myCell As Range
Dim myRng As Range

Set myRng = Nothing
On Error Resume Next
With ActiveSheet 'or with worksheets("sheet1")
Set myRng = Intersect(.Range("o5:Iv2232"), .UsedRange)
End With

If myRng Is Nothing Then
Exit Sub
End If

For Each myCell In myRng.Cells
Select Case LCase(myCell.Value)
Case Is = "b": myColorIndex = 3
Case Is = "v": myColorIndex = 5
Case Else: myColorIndex = xlNone
End Select
myCell.Interior.ColorIndex = myColorIndex
Next myCell

End Sub

By using the "with activesheet", you can run it against any worksheet.
By using the "with worksheets("sheet1"), it only runs against sheet1, but you
can run the macro from any worksheet in that workbook.

In fact, it might be quicker to just seach for the values and fix them (rather
than looping through the whole range):

Option Explicit
Sub testme()

Dim FirstAddress As String
Dim FoundCell As Range
Dim FindWhatList As Variant
Dim myColorList As Variant
Dim iCtr As Long
Dim myRng As Range
Dim myOrigRng As Range

FindWhatList = Array("b", "v")
myColorList = Array(3, 5)

If UBound(FindWhatList) <> UBound(myColorList) Then
MsgBox "design error!"
Exit Sub
End If

With ActiveSheet
Set myOrigRng = .Range("o5:iv2232")
myOrigRng.Interior.ColorIndex = xlNone

Set myRng = Nothing
On Error Resume Next
Set myRng = Intersect(myOrigRng, .UsedRange)
On Error GoTo 0
End With

If myRng Is Nothing Then
Exit Sub
End If

For iCtr = LBound(FindWhatList) To UBound(FindWhatList)
FirstAddress = ""
With myRng
Set FoundCell = .Cells.Find(what:=FindWhatList(iCtr), _
LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlNext, _
after:=.Cells(.Cells.Count))
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
FoundCell.Interior.ColorIndex = myColorList(iCtr)
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
Next iCtr
End Sub
 
W

wammer

Thanks again Dave...is there any way at all for me to change the rang
in the macro to the range that the individual has selected on th
worksheet at the current time?

Thanks
Ca
 
D

Dave Peterson

These kinds of lines set the range:

Set myRng = Intersect(.Range("o5:Iv2232"), .UsedRange)

so
Set myRng = Intersect(Selection, .UsedRange)

should do it.

======

or

Set myOrigRng = .Range("o5:iv2232")
becomes
Set myOrigRng = Selection
 
Top