VBA Auto Cell Formatting Uppercase

[QTE]

Hi Excel Forum,

I am using Excel for Windows 95 v7 (isn't there always one!): I do no
have access to VBA Worksheet Change Event ByVal Target. However, i
possible, I would like to change text entered in a cell to uppercase o
data entry; I know how to change the text to uppercase once it i
already entered.

Can Excel version 7 VBA convert text to uppercase on data entry
Columns involved C, G, J, and R.

I have already used the On_Entry Event in this particular worksheet
can it be used again but distinguishing a particular range of column
"ONLY" to be affected by the uppercase formatting.

Please advise of solutions within Excel V7 VBA.

If possible, please explain with a working example.

Assistance is appreciated.

Kind regards,
QT

 

[Bernie Deitrick]

QTE,

Post the On_Entry Event code that you are currently using.

HTH,
Bernie
MS Excel MVP

 

[QTE]

Hi Bernie,

Here is the On_Entry code:

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").Range("AX5")
Entry
End Sub

Sub Entry()
Workbooks("department.xls").Sheets("officedept").OnEntry
"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

 

[Bernie Deitrick]

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

Hi Bernie,

Here is the On_Entry code:

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").Range("AX5")
Entry
End Sub

Sub Entry()
Workbooks("department.xls").Sheets("officedept").OnEntry =
"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

 

[QTE]

Hi Bernie,

Code is working brilliantly. Thank you very much for your time. Man
Thanks.

*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 Nothin
Then
For Each myCell In Selection
myCell.Value = UCase(myCell.Value)
Next myCell
End If

HTH,
Bernie
MS Excel MVP *

[/QUOTE]


Kind regards,
QT