Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro to change cell colour if critreria is met.. 2

Status
Not open for further replies.

basepointdesignz

Programmer
Jul 23, 2002
566
GB
Hi there,

I'm a bit new to VBA for Excel (I normal use it for AutoCAD) and I'm trying to set up a macro that will change the colour of a cell, depending on the content - basically if the cell contains one of five names, the cell will change to his or her correct colour..

I know that Conditional Formatting works but it only allows for 3 conditions, whereas I need it for 5..

I thought that a For each....Next statement would work but I can't find the correct code and variables for the job..

Could someone help me out?

Thanks in advance..

Renegade..
 
Renegade ... you could try an IF formula combined with an OR for Conditional Formatting:

Change the Cell Value Is to Formula Is in the dialog box, and for cell A1 use the formula
Code:
=IF(A1=(Or("Name1","Name2","Name3","Name4","Name5"),TRUE,FALSE)
Set format to cell colour desired & voila - this worked for me, anyway ;-)

Failing that, use the Sheet_Change event for summat like this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case UCase(Target.Text)
    Case "NAME1", "NAME2", "NAME3", "NAME4", "NAME5"
        Target.Interior.ColorIndex = 36
    End Select
End Sub

I use the ucase just in case - this makes the names entered case-INsensitive.

HTH

Cheers
Nikki

 
Hey Nikki,
I didn't know about the "Formula is" option - that's neat. (star!)
DJRenegade, you'll need to slightly modify Nikki's formula, to:
=IF(OR(A1="Name1",A1="Name2",A1="Name3",A1="Name4",A1="Name5"),TRUE,FALSE)
Rob
[flowerface]
 
Rob,

thanks for the star - AND the correction

That'll teach me to do things off the top of me head

Cheers
Nikki
 
Hi,

Thanks both of you, that's fantastic..

I'll give it a try..

One thing though - I want a different colour for each person. How do I do that for the above formula?

Cheers,

Renegade..
 
Ah, well, now you're back to not being able to use conditional formatting, I'm afraid. Use Nikki's second approach - a Worksheet_change event handler. You'd need, in the select case structure, five different cases (one for each name) assigning five different colors.
If this sounds like gobbledegook, we'll walk you through it :)
Rob
[flowerface]
 
And if you need to colour cells on all sheets in your workbook consider putting the Select Case as a separate sub on a separate module sheet, and calling the sub for each worksheet - that way you'll save yourself a lot of nasty maintenance if you or you users decide to go for another colour for Tom - or Dick or Harry, for that matter... ;-)

Cheers
Nikki
 
Hi,

Thanks I'll try that. How do I set up the macro to run on all worksheets. I already have command buttons on the sheets to run the macro..

Oh, and one more thing. How do I reverse the macro,
ie: reset all cells back to white/clear?

Many thanks again,

Renegade..
 
The beauty of the change event handler is that you won't need a command button to assign the colors - the colors will appear as the entries are typed into the cells. You need to create the event handler on the worksheet object code sheet (double-click on its "Excel object" in the VBE project browser). Setting the colors back is easy if you want the whole worksheet to have the same color

cells.interior.color=vbwhite

If you want to recolor just the cells you previously colored with the change event handler, you'd have to cycle through and check for the cell contents before reassigning the color.
Rob
[flowerface]
 
How would you add formatting depending on the Row Number? For example, there is a set of data whose size changes (i.e. number of rows and columns). I would like all even numbered rows to have one type of format and odd numbered rows to have another type of format and I do not want to formating to extend beyond the data on the column side.

Thanks is advance!
 
Hiya ,

try this:

select the range you want to format; have the code determine thenumber of rows & columns
then use a For ... Next loop

Code:
For l_lRows = 1 to l_rngRangeObject.Rows.Count
  'Use the MOD function to determine whether you're dividing an even or an odd number
  if l_lRows Mod 2 = 0 then 
    'You've got an even row; set row colour to EvenRowColour
    Range(Cells(l_lRow,1), Cells(l_lRows, l_rngRangeObject.Columns.Count).Interior.ColorIndex = 36 ' or whatever colour you like ...
  Else
    'Uneven row: set to different colour
    Range(Cells(l_lRow,1), Cells(l_lRows, l_rngRangeObject.Columns.Count).Interior.ColorIndex = 34 ' or whatever colour you like ...

  End If
Next l_lRows
Something like this should get u started

HTH

Cheers
Nikki
 
Do rows get inserted into your table? If not, just apply the formatting once with a simple macro that iterates through the required number of rows and be done with it. If you need to deal with row insertions, it all of a sudden get MUCH more complicated to do programmatically. But you can do it with conditional formatting: select the whole block of cells you need treated this way, go to
Format - Conditional formatting
Select "Formula is"
and enter
=MOD(ROW(A1),2)=1
(assuming your block starts at A1)
and choose the format which you want to apply to the odd rows.
When new rows are inserted, Excel by default will apply the same formatting as the row above, so your scheme will be preserved.
Rob
[flowerface]
 
Thanks Nikita,
Thanks for the quick response. I've been using the following bit of code to set my range, but it does not work with the code above, so I guess I'm misinterpreting the Range Object. Any corrections?

Worksheets("SearchOut").Select
Application.Goto Reference:="R4C2"
FirstCell = ActiveCell.Address
LastRow = [A65536].End(xlUp).Address
LastColm = [IV1].End(xlToLeft).Address
LastCell = Range(LastRow, LastColm).Address
datalist = FirstCell & ":" & LastCell
Range(datalist).Name = "l_rngRangeObject"

'From Nikita6003
For l_lRows = 1 To l_rngRangeObject.Rows.Count
If l_lRows Mod 2 = 0 Then
Range(Cells(l_lRow, 1), Cells(l_lRows, l_rngRangeObject.Columns.Count)).Interior.ColorIndex = 36
Else
Range(Cells(l_lRow, 1), Cells(l_lRows, l_rngRangeObject.Columns.Count)).Interior.ColorIndex = 34

End If
Next l_lRows

 
rlee - take a look at the conditional formatting approach above as well. As for your code above - it's easiest to just define the number of columns as a variable outside of your loop, and use the variable:
iCols=range(datalist).columns.count
For iRow = 1 To range(datalist).Rows.Count
Range(Cells(iRow, 1), Cells(iRow,iCol)).Interior.ColorIndex = iif(irow Mod 2 = 0,34,36)
End If
Rob
[flowerface]
 
Hiya,

I've adapted your code somewhat (& mine as well... ;-))
Code:
    Dim FirstCell  As String
    Dim LastCell As String
    Dim datalist As String
    Dim l_rngRangeObject As Range
    Dim l_lRows As Long
    Dim rw As Object
    Dim l_wksTable as Worksheet
    
    Set l_wksTable = Worksheets("Sheet1").Select
    l_wksTable.Range("B4").Select
    
    'Get first cell
    FirstCell = ActiveCell.Address
    
    'Get last cell
    LastCell = Selection.SpecialCells(xlCellTypeLastCell).Address
    
    'Determine Range
    datalist = FirstCell & ":" & LastCell
    Set l_rngRangeObject = ActiveSheet.Range(datalist)

    'From Nikita6003
    l_lRows = 0
    For Each rw In l_rngRangeObject.Rows
        l_lRows = l_lRows + 1
        If l_lRows Mod 2 = 0 Then
            rw.Interior.ColorIndex = 36
        Else
            rw.Interior.ColorIndex = 34
        End If
    Next rw

This'll loop thru the rows in your range & colour them accoding to whthter they're on an even or uneven row.

HTH

Cheers
Nikki
 
Thanks Nikita and Rob,

Nikita, I've given you a star for your solution. It works great (although I had to get rid of l_wksTable, for some reason it had a problem with the object?).

Rob, I will also tryout your suggestion as you took the time to respond to my postup. Thanks again!
 
um - the l_wksTable thing prob. didn't work because I used Sheet1 in my code & you used SearchOut ... forgot to change that back - sorry! - and because I left the .Select at the end of the line - stoopid thing to do ....

Change
Code:
Set l_wksTable = Worksheets("Sheet1").Select
to
Code:
Set l_wksTable = Worksheets("SearchOut")
& it should work

Thanks for the star - altho' it seems to be lost in the mail somewhere ;-)
But I'm glad it worked

Cheers
Nikki
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top