Automatically change case is Excel when typed

[harwookf]

I have two worksheets that I need to automatically change the case to Upper
regardless of how it was typed in the first place.
In one worksheet, the range is Column C and in the second worksheet, the
range is Column B.
From looking at various entries from other people, I have a code (see below)
to use which works on one sheet, but not on the other. I'm not sure if it is
because I already have a code to change the colour of cells depending on
their criteria.
Please help.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B:B" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

 

[Gary''s Student]

You will need two separate macros, one for each sheet.

 

[harwookf]

I have the same macro in both worksheets, except one has B:B and the other
has C:C, but it still doesn't work on the sheet that already has another
macro to change the colour of the cells.

Any more ideas?

 

[harwookf]

The error message is saying Compile Error: Ambiguous name detected:
Worksheet_Change

 

[Gary''s Student]

Make sure that you have one and only one sub in each worksheet code area.


You will need to combine the color one with the new one.

 

[Dave Peterson]

Not vigorously tested:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rArea As Range
Dim rCell As Range
Dim nColor As Long
Dim Rng1 As Range
Dim Rng2 As Range

Set Rng1 = Intersect(Target, Me.Range("E:E"))
Set Rng2 = Intersect(Target, Me.Range("b:b"))

On Error GoTo ws_exit

'do the column E stuff
If Not (Rng1 Is Nothing) Then
For Each rCell In Rng1.Cells
Select Case rCell.Value
Case 0, 100
nColor = RGB(255, 0, 0)
Case 30
nColor = RGB(23, 178, 233)
Case 60
nColor = RGB(245, 200, 11)
Case 90
nColor = RGB(0, 255, 0)
Case Else
nColor = RGB(255, 255, 255)
End Select

If Not nColor = -1 Then
rCell.Offset(0, -4).Interior.Color = nColor
Else
rCell.Offset(0, -4).Interior.ColorIndex = _
xlColorIndexNone
End If

Next rCell
End If

'do the column B stuff
If Not (Rng2 Is Nothing) Then
Application.EnableEvents = False
For Each rCell In Rng2.Cells
With rCell
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
Next rCell
End If

ws_exit:
Application.EnableEvents = True

End Sub

 

[ShaneDevenshire]

Hi,

I tested your original code and it work fine although you could shorten it to

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:C" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Range(WS_RANGE)) Is Nothing Then
If Not Target.HasFormula Then
Target = UCase(Target)
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub

 

[harwookf]

Many thanks, this has worked perfectly.

Cheers

Not vigorously tested:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rArea As Range
Dim rCell As Range
Dim nColor As Long
Dim Rng1 As Range
Dim Rng2 As Range

Set Rng1 = Intersect(Target, Me.Range("E:E"))
Set Rng2 = Intersect(Target, Me.Range("b:b"))

On Error GoTo ws_exit

'do the column E stuff
If Not (Rng1 Is Nothing) Then
For Each rCell In Rng1.Cells
Select Case rCell.Value
Case 0, 100
nColor = RGB(255, 0, 0)
Case 30
nColor = RGB(23, 178, 233)
Case 60
nColor = RGB(245, 200, 11)
Case 90
nColor = RGB(0, 255, 0)
Case Else
nColor = RGB(255, 255, 255)
End Select

If Not nColor = -1 Then
rCell.Offset(0, -4).Interior.Color = nColor
Else
rCell.Offset(0, -4).Interior.ColorIndex = _
xlColorIndexNone
End If

Next rCell
End If

'do the column B stuff
If Not (Rng2 Is Nothing) Then
Application.EnableEvents = False
For Each rCell In Rng2.Cells
With rCell
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
Next rCell
End If

ws_exit:
Application.EnableEvents = True

End Sub