Lower Case to Upper Case in column

[magpye]

Sorry to ask such a simple question, but I'm having no luck in finding the answer myself.

I have a work sheet with a number of columns, all working well.

A 'minor' problem I have is that one column only has Text entry required, no problem, but I would like this Text to always be in Upper Case.
Ok, I can use the Shift key, but I'm no typist and I always seem to mess up and have to make corrections.

Is there a way please that I can enter Lower case or a mixture of Lower / Upper case letters that will always end up as Upper case in this particular column?

Thanks for your time.

magpye (John)

 

[Krishnakumar]

Hi,

This goes in the sheet module.

Right click on tab name > view code > paste the code there.

Private Sub Worksheet_Change(ByVal Target As Range)

Const TgtCol    As Long = 4 'Col D Adjust the Column #

If Target.Column <> TgtCol Then Exit Sub
If Target.Row < 2 Then Exit Sub 'Excludes Row # 1

Dim r   As Range

Set r = Intersect(Me.UsedRange, Target)

If Not r Is Nothing Then
    Application.EnableEvents = 0
    r.Value2 = Evaluate("if(row(),upper(" & r.Address & ")," & r.Address & ")")
    Application.EnableEvents = 1
End If

End Sub

HTH

 

[Richard Schollar]

If you only want to do it to new values entered then I think it is more efficient to restrict to only the cell that's changed:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range

On Error GoTo exit_here

If Target.Row > 1 Then 'omit headers as per Kris
    Set rng = Application.Intersect(Range("B:B"), Target) 'assume B is target column for upper casing - amend to whatever appropriare if reqd
    If Not rng Is Nothing Then
        Application.EnableEvents = False  'turn off events so your changes don't recursively activate this code!
        For Each cell In rng
            If Not IsEmpty(cell.Value) Then 'check if a value has been entered in the cell rather than cell being deleted
                cell.Value = UCase(cell.Value)  'change cell co9ntents to upper
            End If
        Next cell
    End If
End If

exit_here:
         
    Application.EnableEvents = True  'make sure to turn events back on
End Sub

 

[Krishnakumar]

@ Richard

My code does the same.

Set r = Intersect(Me.UsedRange, Target)

Here is a revised one which handles non-contiguous range as well.

Private Sub Worksheet_Change(ByVal Target As Range)

Const TgtCol    As Long = 4 'Col D Adjust the Column #

If Target.Column <> TgtCol Then Exit Sub
If Target.Row < 2 Then Exit Sub 'Excludes Row # 1

Dim r   As Range, a As Range

Set r = Intersect(Me.UsedRange, Target)

If Not r Is Nothing Then
    Application.EnableEvents = 0
    If r.Areas.Count > 1 Then
        For Each a In r.Areas
            a.Value2 = Evaluate("if(row(),upper(" & a.Address & ")," & a.Address & ")")
        Next
    Else
        r.Value2 = Evaluate("if(row(),upper(" & r.Address & ")," & r.Address & ")")
    End If
    Application.EnableEvents = 1
End If

End Sub

HTH

 

[Richard Schollar]

Yes, sorry - read it too quickly