Solved: Defining a specific cell range

[staindcold]

How can I modify this code to apply the Case logic to a specific column in Excel? I need the formats to apply only to data in Column G.


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
Select Case Cell.Value

Case vbNullString
Cell.Interior.ColorIndex = xlNone

Case 0 To 0.039999999999
Cell.Interior.ColorIndex = 4

Case 0.04 To 0.059999999999
Cell.Interior.ColorIndex = 6

Case 0.06 To 1
Cell.Interior.ColorIndex = 3

Case Else
Cell.Interior.ColorIndex = xlNone

End Select
Next

End Sub


Thanks!!!!

[lucas]

Try this version of DRJ's conditional format code which is where I think you started with this. You will have to alter the numbers to suit....its set for column S right now so you will have to change that also but I think this will get you going:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
For Each cel In Range("S5:S59").Cells
If IsNumeric(cel.Value) And cel.Value <> "" Then
If cel.Value >= 0 And cel.Value < 0.06 Then
cel.Interior.ColorIndex = 2
ElseIf cel.Value >= 0.06 And cel.Value < 0.1 Then
cel.Interior.ColorIndex = 3
ElseIf cel.Value >= 0.1 And cel.Value < 0.15 Then
cel.Interior.ColorIndex = 46
ElseIf cel.Value >= 0.15 And cel.Value < 0.2 Then
cel.Interior.ColorIndex = 22
ElseIf cel.Value >= 0.25 And cel.Value < 0.3 Then
cel.Interior.ColorIndex = 45
ElseIf cel.Value >= 0.3 And cel.Value < 0.35 Then
cel.Interior.ColorIndex = 44
ElseIf cel.Value >= 0.35 And cel.Value < 0.4 Then
cel.Interior.ColorIndex = 40
ElseIf cel.Value >= 0.4 And cel.Value < 0.45 Then
cel.Interior.ColorIndex = 6
ElseIf cel.Value >= 0.5 And cel.Value < 0.55 Then
cel.Interior.ColorIndex = 19
ElseIf cel.Value >= 0.55 And cel.Value < 0.6 Then
cel.Interior.ColorIndex = 24
ElseIf cel.Value >= 0.6 And cel.Value < 0.65 Then
cel.Interior.ColorIndex = 41
ElseIf cel.Value >= 0.65 And cel.Value < 0.7 Then
cel.Interior.ColorIndex = 32
ElseIf cel.Value >= 0.75 And cel.Value < 0.8 Then
cel.Interior.ColorIndex = 35
ElseIf cel.Value >= 0.8 And cel.Value < 0.85 Then
cel.Interior.ColorIndex = 43
ElseIf cel.Value >= 0.85 And cel.Value < 0.9 Then
cel.Interior.ColorIndex = 50
ElseIf cel.Value >= 0.9 And cel.Value < 1 Then
cel.Interior.ColorIndex = 14
ElseIf cel.Value >= 1 Then
cel.Interior.ColorIndex = 10
Else 'default conditions
cel.Interior.ColorIndex = 0
cel.Font.ColorIndex = 1
End If
Else
cel.Interior.ColorIndex = 0
cel.Font.ColorIndex = 1

End If
Next
End Sub

[staindcold]

Will this work with pasted data? Will it work if I copy blank rows and leave them blank?

[lucas]

yes and with formula's too....

[staindcold]

It doesn't seem to be working.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
For Each cel In Range("G1:G60").Cells
If IsNumeric(cel.Value) And cel.Value <> "" Then
If cel.Value >= 0 And cel.Value < 0.06 Then
cel.Interior.ColorIndex = 2
ElseIf cel.Value <= 0.039999999999 Then
cel.Interior.ColorIndex = 4
ElseIf cel.Value > 0.04 And cel.Value <= 0.059999999999 Then
cel.Interior.ColorIndex = 6
ElseIf cel.Value >= 0.06 Then
cel.Interior.ColorIndex = 3
Else 'default conditions
cel.Interior.ColorIndex = 0
cel.Font.ColorIndex = 1
End If
Else
cel.Interior.ColorIndex = 0
cel.Font.ColorIndex = 1

End If
Next
End Sub


I think the problem may be that I am pasting in data that is a percentage. For example... 2.5% When I used conditional formatting...I had to say less than or equal to 0.0399999999 to make the cell turn green. It would not work with 3.99999999 It does for some reason turn a cell red if the % is greater than 6%.

[Bob Phillips]

yes and with formula's too....

NBot if the formula points at other sheetrs that don't trigger this worksheet's change event.

[lucas]

That's may be true Bob.....in that case you would need to run worksheet.calculate I guess.

[lucas]

It would be a lot easier to help with this if we had a sample of what your working on.....please

[lucas]

Attached is an example. The column with the conditional formatting is formatted for percentages......

[staindcold]

Sorry...I'm new to this forum. How do I attach a file?

I believe I have it working now. I'm not sure what the problem was before. Is there a way to apply border patterns? I need any blank rows to have no border.

Thanks!

[lucas]

Click on post reply in the lower left of the last post...scroll down till you see Manage attachments.

ps you may have to have 5 posts to attach a file...if so you just need one bogus post to allow it as you have 4 now.

[staindcold]

Ugh, the file is too big and I can't get rid of enough data to make it small enough. I did get the two columns formatted, now I need to make sure any blank rows do not have borders.

Edit: I was able to create it in a Zip file.

[lucas]

Hint:
Rows("9:9").Borders.LineStyle = xlNone

[staindcold]

But I won't always know what rows will be blank...

[lucas]

A thread that addresses finding blank rows

you will have to configure this and add it after the condional formatting or in a different sub and call it.

http://www.vbaexpress.com/forum/showthread.php?t=12223&highlight=blank

[lucas]

something like this from Bob's example in the thread I posted:
Public Sub ProcessData()
Dim i As Long
With ActiveSheet
For i = 1000 To 1 Step -1
If Application.CountBlank(.Cells(i, "A").Resize(, 20)) = 20 Then
.Rows(i).Borders.LineStyle = xlNone
End If
Next i
End With
End Sub

[staindcold]

That doesn't seem to change anything...

I can't get it to delete rows either...

[staindcold]

I still need some assistance with clearing the borders for pasted rows that contain no data. I can't seem to get this to work:

Public Sub ProcessData()
Dim i As Long
With ActiveSheet
For i = 1000 To 1 Step -1
If Application.CountBlank(.Cells(i, "A").Resize(, 20)) = 20 Then
.Rows(i).Borders.LineStyle = xlNone
End If
Next i
End With
End Sub

I also tried, just to see, if I could get the blank row to delete. I was unsuccessful at that as well. Any suggestions???

[lucas]

Try this example using the code from your post:

see attached

[staindcold]

The test file works like a charm. How did you add the button? I noticed in the code that it states With ActiveSheet. When I copy the data over...the borders still remain.

[mdmackillop]

Because Select Case exits after a True item, you don't need to set both limits for a range of values. A With statement also gets rid of surplus text
eg

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
For Each cel In Range("S5:S59").Cells
If IsNumeric(cel.Value) And cel.Value <> "" Then
With cel.Interior
Select Case cel.Value
Case Is < 0.06
.ColorIndex = 2
Case Is < 0.1
.ColorIndex = 3
Case Is < 0.15
.ColorIndex = 46
'etc

[lucas]

I'm confused too. In your example file you have conditional format set up to work on column G based on a numeric value but in the example file column g is text??
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
Dim cel2 As Range

For Each cel In Range("G1:G30000").Cells
If IsNumeric(cel.Value) And cel.Value <> "" Then
If cel.Value <= 0.03999999999 Then
cel.Interior.ColorIndex = 4
ElseIf cel.Value >= 0.04 And cel.Value <= 0.05999999999 Then
cel.Interior.ColorIndex = 6
ElseIf cel.Value >= 0.06 Then
cel.Interior.ColorIndex = 3
etc....


To make the processdata sub work in your workbook you need to change the A which refers to column A to a G.....it won't work as is if there is data in column A:
Public Sub ProcessData()
Dim i As Long
With ActiveSheet
For i = 1000 To 1 Step -1
If Application.CountBlank(.Cells(i, "G").Resize(, 20)) = 20 Then
.Rows(i).Borders.LineStyle = xlNone
End If
Next i
End With
End Sub

[lucas]

Add the buttons by right clicking on any toolbar and Check the one that says forms....from that toolbar draw your button then right click on it to assign your macro.

[staindcold]

I just used the button code that you had in the test file and applied it to my spreadsheet. It works great! I can't thank you enough for all the help!!! Only problem I have now is that I lose the pattern on two cells once the conditional formatting is applied. The header rows for G and N lose their pattern. How can I apply the pattern to specific cells?

[lucas]

Glad to help......be sure to mark your thread solved using the thread tools at the top of the page when your done. You can always post followup questions here if it comes up.

[lucas]

Post your questions here so others will benifit.....

Only problem I have now is that I lose the pattern on two cells once the conditional formatting is applied. The header rows for G and N, G1 and N1, lose their pattern. How can I apply the pattern to specific cells in the code?


I think your talking about this part of the code:
For Each cel In Range("G1:G30000").Cells

Change the G1 to G2 to start on the second row...

[staindcold]

Haha...I never even thought of that simple fix.


Thanks!