Hi Bernie,

Here is the On_Entry code:

Bernie Deitrick wrote:
[b]QTE,
Post the On_Entry Event code that you are currently using.
HTH,
Bernie
MS Excel MVP
---

This is the Auto_Open File:

Option Explicit

Sub Auto_Open()
Windows("office.xls").Visible = False
Workbooks.Open("G:\Excel\department.xls").Sheets ("officedept")
Application.Got
Workbooks("department.xls").Sheets("officedept").R ange("AX5")
Entry
End Sub

Sub Entry()
Workbooks("department.xls").Sheets("officedept").O nEntry
"A_Criteria_Entry"
End Sub

Sub A_Criteria_Entry()
[department.xls].[deptanalysis].A_Criteria_Entry
End Sub

'End of Auto_Open File
------------------------------------------------------------------------------------

'In Main Procedure

Set Wks = Sheets("department.xls")
Wks.OnEntry = "A_Criteria_Entry"

Sub A_Criteria_Entry()
'Changes colour of cells that match criteria

Set Wks = Sheets("department.xls")
Wks.Activate
Wks.Range("AX5").NumberFormat = "@"

For Each myCell In Selection

If myCell.Value = "103/1" Then
With myCell.Interior
.ColorIndex = 43
End With

ElseIf myCell.Value = "103/2" Then
With myCell.Interior
.ColorIndex = 4
End With

ElseIf myCell.Value = "103/3" Then
With myCell.Interior
.ColorIndex = 35
End With

ElseIf myCell.Value = "103/4" Then
With myCell.Interior
.ColorIndex = 17
End With

ElseIf myCell.Value = "103/5" Then
With myCell.Interior
.ColorIndex = 24
End With

ElseIf myCell.Value = "103/6" Then
With myCell.Interior
.ColorIndex = 38
End With

End If
Next myCell
Cells(3, 2).Interior.ColorIndex = Cells(5, 50).Interior.ColorIndex
End Sub


Kind regards,
QT

--
Message posted from http://www.ExcelForum.com