QTE,

At the top of

Sub A_Criteria_Entry()

use this code:

If Not Intersect(Selection, Range("C:C,G:G,J:J,R:R")) Is Nothing Then
For Each myCell In Selection
myCell.Value = UCase(myCell.Value)
Next myCell
End If

HTH,
Bernie
MS Excel MVP

"QTE " wrote in message
...
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.Goto
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,
QTE


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