Cannot find inefficient coding loop

Please help,
I have an Excel workbook to schedule work for employees. The
"Schedule" sheet has 80 rows of employee names and 180 columns of
daily work codes. The "Codes" sheet has one column of approved
codes listed in specific colors. When a work code is entered in a cell
on the "Schedule" sheet, I want Excel to check to ensure it is an
approved code and then display it using the color and font formatting
from the "Codes" sheet. An unapproved code should just paint the
cell red and leave it empty.

The sub listed below works (except painting errors red), but it must
have an inefficient error somewhere. If I use the MsgBox's listed to
trap errors, it gives the right data, but repeats the MsgBoxes hundreds
of times before finishing. What am I doing wrong and is there a more
efficient way of accomplishing this?

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then
If Not Intersect(Target, Range("c7:iv100")) Is Nothing Then
Target.Value = UCase(Target.Value)
End If
End If

With Worksheets("Codes").Range("a1:a50")
Set c = .Cells.Find(What:=Target.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not c Is Nothing Then
CodeAddress = c.Address
SchedCode = c.Value
SchedColor = c.Interior.ColorIndex
SchedFont = c.Font.ColorIndex
Else:
MsgBox (Target.Value & " is not an approved code")
Target.Value = Null
SchedColor = 3 'paint red
End If
End With

MsgBox ("code address is " & CodeAddress)
MsgBox ("target value is " & SchedCode)
MsgBox ("target interior color is " & SchedColor)
MsgBox ("target font color is " & SchedFont)

Target.Interior.ColorIndex = SchedColor
Target.Font.ColorIndex = SchedFont

End Sub

Trent,

You've the code in Worksheet Change, ie if you make changes to your
worksheet the code goes into loop. you atleast make changes to your worksheet
4 times if the Code is not approved.

You can have a Public Flag that can be checked in the beginning to indicate
the code is already running and can exit to prevent looping. After the code
gets completed turn off the flag.

Also, you shoukd put the End With after the Set statement.

Arun

"Trent" wrote:

> Please help,
> I have an Excel workbook to schedule work for employees. The
> "Schedule" sheet has 80 rows of employee names and 180 columns of
> daily work codes. The "Codes" sheet has one column of approved
> codes listed in specific colors. When a work code is entered in a cell
> on the "Schedule" sheet, I want Excel to check to ensure it is an
> approved code and then display it using the color and font formatting
> from the "Codes" sheet. An unapproved code should just paint the
> cell red and leave it empty.
>
> The sub listed below works (except painting errors red), but it must
> have an inefficient error somewhere. If I use the MsgBox's listed to
> trap errors, it gives the right data, but repeats the MsgBoxes hundreds
> of times before finishing. What am I doing wrong and is there a more
> efficient way of accomplishing this?
>
> Private Sub Worksheet_Change(ByVal Target As Range)
>
> If Target.Count = 1 Then
> If Not Intersect(Target, Range("c7:iv100")) Is Nothing Then
> Target.Value = UCase(Target.Value)
> End If
> End If
>
> With Worksheets("Codes").Range("a1:a50")
> Set c = .Cells.Find(What:=Target.Value, _
> LookIn:=xlValues, _
> LookAt:=xlWhole, _
> SearchOrder:=xlByRows, _
> SearchDirection:=xlNext, _
> MatchCase:=False)
> If Not c Is Nothing Then
> CodeAddress = c.Address
> SchedCode = c.Value
> SchedColor = c.Interior.ColorIndex
> SchedFont = c.Font.ColorIndex
> Else:
> MsgBox (Target.Value & " is not an approved code")
> Target.Value = Null
> SchedColor = 3 'paint red
> End If
> End With
>
> MsgBox ("code address is " & CodeAddress)
> MsgBox ("target value is " & SchedCode)
> MsgBox ("target interior color is " & SchedColor)
> MsgBox ("target font color is " & SchedFont)
>
> Target.Interior.ColorIndex = SchedColor
> Target.Font.ColorIndex = SchedFont
>
> End Sub
>
>

Yes, the loop is hundreds of cycles long but where is it? It takes 20
seconds just holding down the enter key. Is there a way to break out
while testing?

Can you please give instructions on the "Public Flag" suggestion. I
don't know how to do it.

I moved the End With statement but don't see any difference in results.

Tell excel to stop looking for changes right before you make a change.

For example:

Application.enableevents = false
Target.Value = UCase(Target.Value)
application.enableevents = true

And
Application.enableevents = false
Target.Value = Null
Application.enableevents = true

It turns out that changing the format doesn't make the change event fire. So
you don't need to worry about those last couple of lines.

Trent wrote:
>
> Please help,
> I have an Excel workbook to schedule work for employees. The
> "Schedule" sheet has 80 rows of employee names and 180 columns of
> daily work codes. The "Codes" sheet has one column of approved
> codes listed in specific colors. When a work code is entered in a cell
> on the "Schedule" sheet, I want Excel to check to ensure it is an
> approved code and then display it using the color and font formatting
> from the "Codes" sheet. An unapproved code should just paint the
> cell red and leave it empty.
>
> The sub listed below works (except painting errors red), but it must
> have an inefficient error somewhere. If I use the MsgBox's listed to
> trap errors, it gives the right data, but repeats the MsgBoxes hundreds
> of times before finishing. What am I doing wrong and is there a more
> efficient way of accomplishing this?
>
> Private Sub Worksheet_Change(ByVal Target As Range)
>
> If Target.Count = 1 Then
> If Not Intersect(Target, Range("c7:iv100")) Is Nothing Then
> Target.Value = UCase(Target.Value)
> End If
> End If
>
> With Worksheets("Codes").Range("a1:a50")
> Set c = .Cells.Find(What:=Target.Value, _
> LookIn:=xlValues, _
> LookAt:=xlWhole, _
> SearchOrder:=xlByRows, _
> SearchDirection:=xlNext, _
> MatchCase:=False)
> If Not c Is Nothing Then
> CodeAddress = c.Address
> SchedCode = c.Value
> SchedColor = c.Interior.ColorIndex
> SchedFont = c.Font.ColorIndex
> Else:
> MsgBox (Target.Value & " is not an approved code")
> Target.Value = Null
> SchedColor = 3 'paint red
> End If
> End With
>
> MsgBox ("code address is " & CodeAddress)
> MsgBox ("target value is " & SchedCode)
> MsgBox ("target interior color is " & SchedColor)
> MsgBox ("target font color is " & SchedFont)
>
> Target.Interior.ColorIndex = SchedColor
> Target.Font.ColorIndex = SchedFont
>
> End Sub

--

Dave Peterson

Dave,

Outstanding!!! Thanks -- that feature works perfectly now.

Trent