View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Cannot find inefficient coding loop

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