Wanted - Conditional, formatting macro

  • Thread starter Thread starter Dan E
  • Start date Start date
D

Dan E

New to VBA, I'm struggling to do the following:-
For each row (y) starting at row 5 (say)
If the intersection of the row and column AT (say) has a value "X"
Then, in that row, for each cell with no content, change the
cell.interior.colorindex to No Fill (zero?), leaving cells WITH content
unchanged;
y = y + 1
Repeat for each row to the end of the ActiveSheet.UsedRange

Basically, I'm using a column (AT) as a marker for rows containing cells
that the macro needs to work on. If there's no content in AT9, say, the
macro should leave row 9 alone.

Any help gratefully received,
TIA,
Dan
 
Dan
here is the code for what you want to do.
i hope this suffices, or else please reply (Always test codes first on
backup copy & then use it)

Sub CondFormat()
Dim i As Long, j As Integer, l As Long
Dim temp1 As String
For i = 5 To ActiveSheet.UsedRange.Rows.Count
Cells(i, 46).Select
If Cells(i, 46) = xlblank Then ActiveCell.Interior.ColorIndex =
-4142
Next i
End Sub

Regards
NC
 
Hi Dan,

One way

Sub myRows()
Dim oRow As Range
Dim cell As Range

For Each oRow In ActiveSheet.UsedRange.Rows
If Cells(oRow.row, "AT").Value = "X" Then
For Each cell In Cells(oRow.row, "AT").EntireRow.Cells
If IsEmpty(cell.Value) Then
cell.Interior.ColorIndex = xlColorIndexNone
End If
Next cell
End If
Next oRow

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
NC,

Sorry to be picky, but there are a lot of problems with this code.

First, there is no constant xlBlank (at least not in Excel 2000 that I
have).

Then, you do not test column AT for an X as Dan stated, and you only change
coilumn AT to no fill when Dan asked for all empty cells in the row to be
no-filled (AT will be one column that will have content).

You also loop from Row 5 to the count of rows in the used. Consider this
situation, there are 3 rows in the used. Looping from 5 to 3 means the code
never executes. At the very least you miss the last 4 rows even if Used row
count is greater than 5.

Those are serious flaws in the code, but a few other suggestions offered in
good faith.

You declare a string variable temple, and longs of job and law which are
never used.
You do a select of the cells which is not necessary (select is rarely
necessary).
Excel has a constant for no colour, xlColorIndexNone, which is more readable
than -4142
In the Cells property, the column can be expressed by letters,
Cells(I,"AT"), which aids understandability

You code could be written as

Sub CondFormat()
Dim i As Long, Dim j As Long
For i = 5 To ActiveSheet.UsedRange.Rows.Count + _
ActiveSheet.UsedRange.Cells(1,1).Row - 1
If Cells(i, "AT") = "X" Then
For j = 1 to 255
If Cells(i,j).Value = "" Then
Cells(j,i).Interior.ColorIndex = xlColorIndexNone
End If
Next j
End If
Next i
End Sub
--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Hi Bob, Many many thanks again, and to NC. Thinking about this last night,
I realised that, ideally, this bit of necessary fiddling should be
incorporated into the other "Color_Text" sub you helped me out with. Below
is a current example of Color_Text from one my scheduling sheets - I can
almost see how to incorporate your new code, but can't quite grasp it.
Basically, if the user changes the position of one of the codes that needs
to have a specific color background (gives the shift to a different person),
running the current coloring code will correctly color in the new shift
position, but doesn't set the cell where the shift used to be to "No Fill",
meaning that the user has to unprotect the sheet, manually change the color
of the now-empty cell to No Fill, then protect the sheet again. Clearly, it
would be good if they only have to run one macro to do everything. Here's
the current sub:-

Sub Color_Text()
ActiveSheet.Unprotect
Dim Cell As Range
Dim col As Integer
On Error GoTo ws_next
For Each Cell In ActiveSheet.UsedRange
If Cell.Interior.ColorIndex = 1 Or _
Cell.Interior.ColorIndex = 15 Then
ElseIf Len(Cell.Value) = 2 Or Len(Cell.Value) = 3 Then
Select Case LCase(Cell.Value)
Case "um": col = 40
Case "rnm": col = 38
Case "mi": col = 35
Case "ml": col = 36
Case "mn": col = 37
Case "mq": col = 24
Case "m1": col = 35
Case "m2": col = 36
Case "m3": col = 8
Case "m14": col = 38
Case "m4": col = 24
Case "m11": col = 43
Case "m7": col = 22
Case "m8": col = 20
Case "m16": col = 19
Case "m17": col = 27
Case "m15": col = 45
Case Else: col = Cell.Interior.ColorIndex
End Select
Cell.Interior.ColorIndex = col
End If
ws_next:
Next
ws_exit:
ActiveSheet.Protect
End Sub

Any help much appreciated.
TIA
Dan
 
Bob - re. my last message - would either of these work - a) nest one sub
inside the other, or b) put both subs, one following the other, inside a
main sub whose job is simply to contain the two subs?

TIA

Dan
 
Hi Bob - I took my courage in my hands and tried the code below, which
worked, if a little slowly. Once I get this fix-up for a venerable
bug-ridden spreadsheet out of the way, I might have time to learn something
about VBA! Many many thanks again for all your help:-
________________________
Sub Color_Main()
ActiveSheet.Unprotect
Color_Text
myRows
ActiveSheet.Protect
End Sub

Sub Color_Text()
Dim cell As Range
Dim col As Integer
On Error GoTo ws_next
For Each cell In ActiveSheet.UsedRange
If cell.Interior.ColorIndex = 1 Or _
cell.Interior.ColorIndex = 15 Then
ElseIf Len(cell.Value) = 2 Or Len(cell.Value) = 3 Then
Select Case LCase(cell.Value)
Case "um": col = 40
Case "rnm": col = 38
Case "mi": col = 35
Case "ml": col = 36
Case "mn": col = 37
Case "mq": col = 24
Case "m1": col = 35
Case "m2": col = 36
Case "m3": col = 8
Case "m14": col = 38
Case "m4": col = 24
Case "m11": col = 43
Case "m7": col = 22
Case "m8": col = 20
Case "m16": col = 19
Case "m17": col = 27
Case "m15": col = 45
Case Else: col = cell.Interior.ColorIndex
End Select
cell.Interior.ColorIndex = col
End If
ws_next:
Next
ws_exit:
End Sub

Sub myRows()

Dim oRow As Range
Dim cell As Range
On Error GoTo ws_next2
For Each oRow In ActiveSheet.UsedRange.Rows
If Cells(oRow.Row, "AT").Value = "X" Then
For Each cell In Cells(oRow.Row, "AT").EntireRow.Cells
If IsEmpty(cell.Value) Then
cell.Interior.ColorIndex = xlColorIndexNone
End If
Next cell
End If
ws_next2:
Next oRow

End Sub
___________________________
Dan
 
Here's a slight variation to Bob's excellent idea using xlCellTypeBlanks.

Sub Demo()
Dim r As Long
Dim c As Long

ActiveSheet.UsedRange
c = Cells(1, "AT").Column

On Error Resume Next
For r = 5 To Cells.SpecialCells(xlCellTypeLastCell).Row
If Cells(r, c) = "X" Then
Rows(r).SpecialCells(xlCellTypeBlanks).Interior.ColorIndex =
xlColorIndexNone
End If
Next r
End Sub

Just an idea...If you were thinking of "xlblanks" instead, it happens to
have the same value as "xlCellTypeBlanks"

?xlblanks
4
?xlCellTypeBlanks
4
 
Hi bob,
thanks for pointing my mistakes positively
it will surely help write better code in future.
also i hope now "xlblank" will not trouble you more after Dana's
explainations

Thanks & Regards
NC
 
Back
Top