Code looping until machine freezes!!?

[Simon Lloyd]

Hi all,

I have tried to devise some code so that if a cell in a set rang
contains a value or character of any kind to change to a colour, i
works but seems to loop many times until my machine freezes (i ca
press escape to get out of it!) any ideas why and perhaps a nudge i
the right direction please!
Thanks,

Simon.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mycell
Dim rng As Range

Set rng = Range("V2:V40")
For Each mycell In rng
If mycell <> "" Then
mycell.Select
With Selection.Interior
.ColorIndex = 44
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
Next
End Su

 

[Simon Lloyd]

Ok Ok so i'm a little numb!

Sorted it, it seems because i made it in Worksheet SelectionChange i
kept starting itself because a change had been made etc.

I would like it to run automatically when a value or character i
entered in the range, right now i have assigned it to a button but it
not ideal.

Regards,

Simon

 

[Norman Jones]

Hi Simon,

Try:
'===============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rCell

Set rng = Range("V2:V40")

If Not Intersect(rng, Target) Is Nothing Then
For Each rCell In rng.Cells
With rCell
If Not IsEmpty(.Value) Then
With .Interior
.ColorIndex = 44
.Pattern = xlSolid
End With
End If
End With
Next rCell
End If

End Sub
'<<===============

---
Regards,
Norman



"Simon Lloyd" <[email protected]>
wrote in message
news:[email protected]...

 

[Jim Cone]

Simon,

You can turn off the cascading events with...
Application.EnableEvents = False, but it must be turned
back on at the end of the code for Excel to function normally.
I made the following changes...
added the EnableEvents code
added leading dots necessary for the use of With
added a code line to remove the formatting if nothing in cell.
Also it seemed to make more sense to use the "Change" event
instead of the "Selection Change" event.

Regards,
Jim Cone
San Francisco, USA


"--------------
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Cleanup
Application.EnableEvents = False
Dim Mycell As Excel.Range
Dim rng As Excel.Range
Set rng = Range("V2:V40")
If Not Application.Intersect(Target(1), rng) Is Nothing Then
For Each Mycell In rng
If Len(Mycell) Then
With Mycell.Interior
.ColorIndex = 44
.Pattern = xlSolid
End With
End If
Next
End If
Err_Cleanup:
Application.EnableEvents = True
End Sub
'------------------


"Simon Lloyd"
wrote in message
Hi all,
I have tried to devise some code so that if a cell in a set range
contains a value or character of any kind to change to a colour, it
works but seems to loop many times until my machine freezes (i can
press escape to get out of it!) any ideas why and perhaps a nudge in
the right direction please!
Thanks,
Simon.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mycell
Dim rng As Range

Set rng = Range("V2:V40")
For Each mycell In rng
If mycell <> "" Then
mycell.Select
With Selection.Interior
ColorIndex = 44
Pattern = xlSolid
PatternColorIndex = xlAutomatic
End With
End If
Next
End Sub
Simon Lloyd

 

[Norman Jones]

Hi Simon,

Perhaps, better would be:

'===============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rCell

Set rng = Range("V2:V40")

If Not Intersect(rng, Target) Is Nothing Then
For Each rCell In rng.Cells
With rCell
If Not IsEmpty(.Value) Then
.Interior.ColorIndex = 44
Else
.Interior.ColorIndex = xlNone
End If
End With
Next rCell
End If

End Sub
'<<===============

This version removes the color if a cell's value is deleted.

 

[Jim Cone]

Oops, left out the line to remove the formatting...
Jim Cone
'-----------
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Cleanup
Application.EnableEvents = False
Dim Mycell As Excel.Range
Dim rng As Excel.Range
Set rng = Range("V2:V40")
If Not Application.Intersect(Target(1), rng) Is Nothing Then
For Each Mycell In rng
If Len(Mycell) Then
With Mycell.Interior
.ColorIndex = 44
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Mycell.ClearFormats
End If
Next
End If
Err_Cleanup:
Set rng = Nothing
Application.EnableEvents = True
End Sub

 

[Norman Jones]

Hi Simon,

And to avoid unnecessary loops, try:

'===============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rCell

Set rng = Intersect(Target, Range("V2:V40"))

If Not rng Is Nothing Then
For Each rCell In rng.Cells
With rCell
If Not IsEmpty(.Value) Then
.Interior.ColorIndex = 44
Else
.Interior.ColorIndex = xlNone
End If
End With
Next rCell
End If

End Sub
'<<===============

 

[Guest]

not sure if it will work but
try turning off events
then your code
then turn events back on

 

[Dana DeLouis]

As an alternative, would Conditional Formatting work for you?

Sub Demo()
With Range("V2:V40")
.Select
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlExpression, _
Formula1:="=NOT(ISBLANK(V2))"
With .FormatConditions(1).Interior
.ColorIndex = 44
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End With
End Sub

HTH :>)

--
Dana DeLouis
Win XP & Office 2003


"Simon Lloyd" <[email protected]>
wrote in message
news:[email protected]...

 

[Norman Jones]

Hi Dana,

A much better suggestion!

 

[Simon Lloyd]

Fantastic!!!!!!!!!!!

Lots of great suggestions.........i didnt expect such a good
response..............thank you all.

In hindsight i will use the conditional formatting its much cleaner and
simpler!

Thanks,

Simon