Thread: color after depending on 1st value in a cell

Howdy All,

I have another macro request.

I would like to ‘grey out’ a certain qty of cells depending on the 1st number in another cell. So 1st of all it would have to check in column B to see if there is any data and then check for the first number in that cell (there will be many numbers in the cells but we only need the 1st one (Ex.: B3 = “3 / 8 & 8”).

Then it should start counting from column D the found number of cells multiplied by 2.

Ex.: if Cell B3 contains “3 / 8 & 8” it will count 3 x 2 = 6 (3 cells x 2 = 6 cells)

Then, if after that count (now at I3), in the next cell over (J3) if the is data in the cell above (J2) then it should apply an Interior.ColorIndex of 15 for the next cells until there is no data in the cells above (if nothing after K2 the grey will be applied to cells J3 & K3 only).

I hope that I’ve described it ok

Any help is appreciated

Pedy

I must say that's a very weird routine you have there
here's the code anyways. I haven't included any error handling.
since I didn't know how the macro will run, I have based it on active cell and as per your example I used column B as reference. Let me know if something is not clear.

Code:

Sub highlight_cells()
Dim rw As Integer, lcol As Integer
Dim cellcount As Integer
Dim chkvalue As Variant
Dim cell1 As String
Dim cell2 As String

rw = Application.ActiveCell.Row
cellcount = Int(Left(Range("B" & rw).Value, 1))
cellcount = cellcount * 2
chkvalue = Cells(rw - 1, cellcount + 4).Value
If chkvalue <> "" Then
    cell1 = Cells(rw, cellcount + 4).Address
    lcol = Range("ZZ" & rw - 1).End(xlToLeft).Column
    cell2 = Cells(rw, lcol).Address
    Range(cell1 & ":" & cell2).Interior.ColorIndex = 15
End If
End Sub

Hi Keyur,

Thanks o much for the reply.

Yes it is a pretty routine I admit.

I just tried out the code but I get a "Run-time error '13': Type mismatch" on this line:

cellcount = Int(Left(Range("B" & rw).Value, 1))

I tried it in a module and in general code with the same result. Have I done something wrong ?

Pedy

Pedy:

You can do this with Conditional Formatting alone, but that may not be what you want. I've attached a demonstration.

Hi Ancalagon12321,

Thanks for the reply!

Unfortunatley conditional formating won't do because my worksheet is being generated from the results of another worksheet and therefore I can't assign (at least I think I can't) conditional formating to a sheet that has not been created yet. The routing is to complete the results of the 1st sheet and depending on those results certain areas will be 'greyed out'.

If there is a way, please let me know if there is a way to assign conditional formating through a macro.

Thanks

Pedy

Hi Pedy,
attached is a sample file. I am not sure why you get that error. but if you still do then see if it works without the INT function. there was another error I noticed is that I used ZZ in my range function which is not available in 2003.

Yup that file works alright. I'll have to test it in my file but what I did notice is that it only highlights the selected row and I would need it to run on the whole page. I must mention though that I have many sections where it should run so there are empty rows & some where there is text.

Thanks again

Pedy

I forgot to mention that the values (numbers in the cell) are references from another sheet. But I tested the same kind of reference on the file you sent and it works just fine...

Since the highlighting of the current row is based on previous row, what do you check for the first row of data? The code below will run from 2nd row to last filled row.

Code:

Sub highlight_cells()
Dim rw As Integer, lcol As Integer
Dim cellcount As Integer
Dim chkvalue As Variant
Dim cell1 As String
Dim cell2 As String

lrw = Range("A" & 60000).End(xlToLeft).Column
For rw = 2 To lrw

    cellcount = Int(Left(Range("B" & rw).Value, 1))
    cellcount = cellcount * 2
    chkvalue = Cells(rw - 1, cellcount + 4).Value
    If chkvalue <> "" Then
        cell1 = Cells(rw, cellcount + 4).Address
        lcol = Range("AA" & rw - 1).End(xlToLeft).Column
        cell2 = Cells(rw, lcol).Address
        Range(cell1 & ":" & cell2).Interior.ColorIndex = 15
    End If

Next
End Sub

well actually the highlight end is based on the previous row. The highlight start is based on the first value in the cell of column B of the same row.

Idealy it should look for to words (let's say 'Start' for the first word and 'End' for the second word) the codde should run between every occurence of the 2 paired words. Now I already have a section of code for this so I would try to instert the highlight code within that portion.

Here' an example of what I would like to achieve:

Code:

Nothing in this row 
Generated WorkSheet
Nothing in this row 	 	 	
Header 1
Nothing in this row  	 	
Data 1
Nothing in this row  	 	 	
Start (word1) (A8) |    $B$8    |   $C$8   |  $D$8  |  $E$8  |  $F$8  |  $G$8  |  $H$8  |  $I$8  |  $J$8  |  $K$8  |  $L$8  |  $M$8  |  ETC.
Data 1 line 1      | 3 / 8 -12g | 1 step 1 |        |        |        |        |        |        |  fill  |  fill  |  fill  |  fill  |
Data 1 line 2      | 4 / 8 -12g | 2 step 1 |        |        |        |        |        |        |        |        |  fill  |  fill  |
Data 1 line 3      | 2 / 8 -12g | 3 step 1 |        |        |        |        |  fill  |  fill  |  fill  |  fill  |  fill  |  fill  |
End (word2)
Nothing in this row  	 	 	
Header 2	
Nothing in this row  	 	
Data 2
Nothing in this row  	 	 	
Start (word1) (A20) |    $B$20   |  $C$20   |  $D$20  |  $E$20  |  $F$20  |  $G$20  |  $H$20  |  $I$20  |  $J$20  |  $K$20  |  $L$20  |  $M$20  |  ETC.
Data 1 line 1       | 3 / 8 -12g | 1 step 1 |         |         |         |         |         |         |   fill  |   fill  |   fill  |   fill  |
Data 1 line 2       | 2 / 8 -12g | 2 step 1 |         |         |         |         |   fill  |   fill  |   fill  |   fill  |   fill  |   fill  |
Data 1 line 3       | 3 / 8 -12g | 3 step 1 |         |         |         |         |         |         |   fill  |   fill  |   fill  |   fill  |
End (word2)

However, I can't seem to get your new code to work in either my file or the one that you sent before...

Hey pedy,
sorry, i found some errors in my previous code as well. i have attached another spreadsheet with two codes. the first one can run through the entire column and fill the cells. the second sub routine you can use to insert in your existing code - just get start row - 'srw' and end row - 'erw' to be used in For Next Loop.

Hey Keyur,

I figured out the main reason why it wasn't working. The stop highlight is based on the row above but not each row above (sorry my bad). Using the example that I sent, in the first section, the stop highlight uses the row above the first "Data 1 line 1" (the Start (word1)) and that wwhole section uses that row ( in this case row 8). In the next section it is row 20.

Since the row to define the stop highlight is never in the same place it would be best i think to look for the (the Start (word1)).

Sorry about that

Hi again Keyur,

I've made a few changes to make your code on my 'empty' table. I included a part to add "*" to the empty cells and the highlight now works.

Here it is:

Code:

 With Range(.Cells(Exercise.Row + 1, 4), .Cells(Comments.Row - 1, LC)) 'adds * in the cells
 .Value = "*"
 .Font.ColorIndex = 2
 End With

and I'm using your code:

Code:

Dim lrw As Integer, lcol As Integer, rw As Integer
Dim cellcount As Integer
Dim chkvalue As Variant
Dim cell1 As String
Dim cell2 As String

On Error Resume Next

lrw = Range("A" & 100).End(xlToRight).Column
For rw = 2 To lrw

    cellcount = Int(Left(Range("B" & rw).Value, 1))
    cellcount = cellcount * 2
    chkvalue = Cells(rw - 1, cellcount + 4).Value
    If chkvalue <> "" Then
        cell1 = Cells(rw, cellcount + 4).Address
        lcol = Range("AA" & rw - 1).End(xlToLeft).Column
        cell2 = Cells(rw, lcol).Address
        Range(cell1 & ":" & cell2).Interior.ColorIndex = 15
        Range(cell1 & ":" & cell2).Font.ColorIndex = 15
    End If
Next

near the end of the macro.

It's working fine but now I would like to remove all the extra "*" after the highlight has executed.

I'm working on that now...

I have a single cell that I input dead into when the lead is no good. I have managed to work out in conditional formatting to turn red but how do I make the rest of the cells in the same row turn red, they have names like date name telephone and are on the same line.
Thank you

Hi Pedy,
sorry I am a bit lost in that what range you are trying to place "*". if the removal of "*" is part of the same routine then the range where you added the "*" will still be available to you.


Livvid, please start a new thread with your question. Your question might be lost in someone's thread.