CODE given: Please help to rectify the error

[Thulasiram]

Hello all,

I am trying to solve this situation by click event and NOT by
selectionchange event.. So, no target.value stuff. All I am trying to
do is pretty simple (but I face errors..). It is as follows. I have
given examples with the algorithm to ease reader's understanding
(hopefully)

In the range("A2:A6"), check the following for each cell.
1. If any cell has a colorindex = 3,4,or 6 then

2. Consider that cell's row.
For example, if A3 is a cell that has a colorindex of 3,4 or 6 then
consider B3 to IV3

3. In that row, if any cell has a numerical value, then highlight the
first cell of the corresponding column.
For example, in B3 to IV3, if E3, G3, J3 have a numerical value, then
highlight E1, G1, J1 with a colorindex 3.

4. Do the same for every cell in that range("A2:A6").

I have written the following code for this.. I face an error that says
that 'for' control is already in use. But, I cant think about modifying
the code without two 'for' statements.

Please provide your expertise to solve this problem.

Private Sub CommandButton1_Click()
For Each cell In Sheet1.Range("A2:A6")
If cell.Interior.ColorIndex = 3 Or cell.Interior.ColorIndex = 6 Or
cell.Interior.ColorIndex = 4 Then

Range("B1:IV1").Interior.ColorIndex = xlNone

Set rng = cell.Offset(0, 1).Resize(1, 255)
Set rng1 = Nothing
On Error Resume Next

Set rng1 = rng.SpecialCells(xlConstants)
On Error GoTo 0
If Not rng1 Is Nothing Then
For Each cell In rng1
If cell.Value < 0 Or cell.Value > 0 Then
Sheet1.Cells(1, cell.Column).Interior.ColorIndex = 3
End If
Next
End If
End If
Next
End Sub

 

[Greg Wilson]

Try:

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim c As Range, cc As Range
Dim rng As Range, rng1 As Range

Set ws = Sheet1
'Consider placing next line here instead depending on your intention
'ws.Range("B1:IV1").Interior.ColorIndex = xlNone
For Each c In ws.Range("A2:A6").Cells
With c.Interior
If .ColorIndex = 3 Or .ColorIndex = 6 Or .ColorIndex = 4 Then
ws.Range("B1:IV1").Interior.ColorIndex = xlNone
Set rng = c(1, 2).Resize(1, 255)
On Error Resume Next
Set rng1 = rng.SpecialCells(xlConstants)
On Error GoTo 0
If Not rng1 Is Nothing Then
For Each cc In rng1.Cells
If IsNumeric(cc.Value) Then
ws.Cells(1, cc.Column).Interior.ColorIndex = 3
End If
Next
End If
End If
End With
Next
End Sub

Regards,
Greg

 

[Thulasiram]

Greg,

First of all, thanks a ton for solving my problem.. Now I am able to
understand why I got an error for the 'for' loop..

Also, you are right!
ws.Range("B1:IV1").Interior.ColorIndex = xlNone should be before the
'for' loop..

Also, my condition was any numerical value other than zero (I did not
mention it in my previous mail, though).. So, I just modified that line
in your code to suit my need.. It is given below..

If cc.Value < 0 Or cc.Value > 0 Then
ws.Cells(1, cc.Column).Interior.ColorIndex = 3
End If

Thanks again,
Regards,
Thulasiram

 

[Thulasiram]

A slight modification to the previous code.. Help reuqested for that..

Code given to my previous question is just for sheet1. I want the same
to be applied to each sheet. I was wondering how to apply it to using
for loop..

If it for the sheets in the entire workbook then it would have been

Dim ws As Worksheet
Dim c As Range, cc As Range
Dim rng As Range, rng1 As Range

For Each ws In ThisWorkbook.Worksheets
ws.Range("B1:IV1").Interior.ColorIndex = xlNone
For Each c In ws.Range("A2:A74").Cells
With c.Interior
If .ColorIndex = 3 Or .ColorIndex = 6 Or .ColorIndex = 4 Then
Set rng = c(1, 2).Resize(1, 255)
On Error Resume Next
Set rng1 = rng.SpecialCells(xlConstants)
On Error GoTo 0
If Not rng1 Is Nothing Then
For Each cc In rng1.Cells
If cc.Value < 0 Or cc.Value > 0 Then
ws.Cells(1, cc.Column).Interior.ColorIndex = 3
End If
Next
End If
End If
End With
Next
Next

I was wondering what if I want this loop from sheet 8 to sheet 30 and
NOT for the all worksheets in the workbook.

I tried this:

sub test()
Dim ws As Worksheet
Dim c As Range, cc As Range
Dim rng As Range, rng1 As Range

For i = 8 to 30
set ws = sheet(i) ' =======> seems silly in VBA terms but this is what
I actually want..
ws.Range("B1:IV1").Interior.ColorIndex = xlNone
For Each c In ws.Range("A2:A74").Cells
With c.Interior
If .ColorIndex = 3 Or .ColorIndex = 6 Or .ColorIndex = 4 Then
Set rng = c(1, 2).Resize(1, 255)
On Error Resume Next
Set rng1 = rng.SpecialCells(xlConstants)
On Error GoTo 0
If Not rng1 Is Nothing Then
For Each cc In rng1.Cells
If cc.Value < 0 Or cc.Value > 0 Then
ws.Cells(1, cc.Column).Interior.ColorIndex = 3
End If
Next
End If
End If
End With
Next

Next

end sub

Please help...

Thanks,
Thulasiram

 

[Thulasiram]

For Each ws In Sheets(Array("Sheet8", "Sheet9", "Sheet11", "Sheet12",
"Sheet13", "Sheet14", "Sheet15", "Sheet16", "Sheet17", "Sheet18",
"Sheet19", "Sheet20"))

I tried the above.. I got an error: Runtime error '9' Subscript out of
range..

Any idea.. please provide a solution.

Thanks,
Thulasiram.

 

[Thulasiram]

Code below solves the problem. I am posting it so that no one ponders
over the problem I posted earlier!

For i = Worksheets("AAA").Index To Worksheets("LLL").Index
With Worksheets(i)
Set ws = Worksheets(i)
ws.Range("B1:IV1").Interior.ColorIndex = xlNone
For Each c In ws.Range("A2:A74").Cells
With c.Interior
If .ColorIndex = 3 Or .ColorIndex = 6 Or .ColorIndex =
4 Then
Set rng = c(1, 2).Resize(1, 255)
On Error Resume Next
'Set rng1 = rng.SpecialCells(xlConstants)
Set rng1 =
rng.SpecialCells(xlCellTypeAllFormatConditions)
On Error GoTo 0
If Not rng1 Is Nothing Then
For Each cc In rng1.Cells
If cc.Value < 0 Or cc.Value > 0 Then
ws.Cells(1,
cc.Column).Interior.ColorIndex = 3
End If
Next
End If
End If
End With
Next
End With
Next