Specific cell must be Ucase advice

[ipbr21054]

Hi,

I have the code shown below.
My intention is that cell Z21 must be UPPERCASE

So typing tom jones in cell Z21 then when i leave that cell it changes to TOM JONES

Private Sub Worksheet_Change(ByVal Target As Range)


With ThisWorkbook.Sheets("HONDA SHEET")
If Not Intersect(Target, .Range("A13")) Is Nothing And .Range("A13") <> "" Then
If Len(.Range("A13").Value) <> 17 And Len(.Range("A13").Value) <> 11 Then
                .Range("A13").Interior.ColorIndex = 3
                 MsgBox "Honda Japan Use 11 Character Vin Numbers." & vbNewLine & "" & vbNewLine & "Honda Europe Use 17 Character Vin Numbers." & vbNewLine & "" & vbNewLine & "Please Check & Try Again", vbCritical, "Chassis Number Wrong Character Count"
                .Range("A13").ClearContents
                .Range("A13").Interior.ColorIndex = 2
                .Range("A13").Activate
Else
                Application.EnableEvents = False
                .Rows(21).Insert Shift:=xlDown
                .Range("A21:G21").Borders.Weight = xlThin
                .Range("G21").Value = Date
                .Range("A21").Value = UCase(.Range("A13").Value)
                .Range("B21").Select
                .Range("A13").ClearContents
                .Range("A21").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                 Application.EnableEvents = True
End If
End If


End With


Target.Interior.ColorIndex = 6 '   *** THIS IS CELL A13 ***
If Not Intersect(Target, Range("F21")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub


End If
    If Target.Address = "$F$21" Then
        Call sheettolist




End If
Application.EnableEvents = True


[COLOR=#ff0000]Dim UpperCase As String[/COLOR]
[COLOR=#ff0000]UpperCase = Range("Z21").Value[/COLOR]


End Sub

 

[Joe4]

That block of code would look like this:

If Not Intersect(Target, Range("Z21")) Is Nothing Then
    Application.EnableEvents = False
    Range("Z21").Value = UCase(Range("Z21").Value)
    Application.EnableEvents = True
End If

 

[ipbr21054]

Like this as when i leave the cell its still small case ?

Private Sub Worksheet_Change(ByVal Target As Range)


With ThisWorkbook.Sheets("HONDA SHEET")
If Not Intersect(Target, .Range("A13")) Is Nothing And .Range("A13") <> "" Then
If Len(.Range("A13").Value) <> 17 And Len(.Range("A13").Value) <> 11 Then
                .Range("A13").Interior.ColorIndex = 3
                 MsgBox "Honda Japan Use 11 Character Vin Numbers." & vbNewLine & "" & vbNewLine & "Honda Europe Use 17 Character Vin Numbers." & vbNewLine & "" & vbNewLine & "Please Check & Try Again", vbCritical, "Chassis Number Wrong Character Count"
                .Range("A13").ClearContents
                .Range("A13").Interior.ColorIndex = 2
                .Range("A13").Activate
Else
                Application.EnableEvents = False
                .Rows(21).Insert Shift:=xlDown
                .Range("A21:G21").Borders.Weight = xlThin
                .Range("G21").Value = Date
                .Range("A21").Value = UCase(.Range("A13").Value)
                .Range("B21").Select
                .Range("A13").ClearContents
                .Range("A21").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                 Application.EnableEvents = True
End If
End If


End With


Target.Interior.ColorIndex = 6 '   *** THIS IS CELL A13 ***
If Not Intersect(Target, Range("F21")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub


End If
    If Target.Address = "$F$21" Then
        Call sheettolist




End If
Application.EnableEvents = True


[COLOR=#ff0000]If Not Intersect(Target, Range("Z21")) Is Nothing Then
    Application.EnableEvents = False
    Range("Z21").Value = UCase(Range("Z21").Value)
    Application.EnableEvents = True
End If[/COLOR]
End Sub

 

[Joe4]

Something is probably making you exit the sub before it gets to that point.
Put a break point at the beginning of your sub, and make an entry into cell Z21.
Then it, should take you into your code where you can use the F8 key to go through it line-by-line, and you can see exactly what it is doing and where it is exiting the code.

 

[ipbr21054]

I click next to this line, If Not Intersect(Target, Range("Z21")) Is Nothing Then
I now see the red dot on the left.
I go to the sheet and wfrite test in cell Z21 then leave the cell.
I am taken back to the code where i now see the code line above yellow
I then F8 and it goes straight to END IF then END SUB then the is gone.

Thats it.

Can we add it into this piece of code ?

Else
                Application.EnableEvents = False
                .Rows(21).Insert Shift:=xlDown
                .Range("A21:G21").Borders.Weight = xlThin
                .Range("G21").Value = Date
                .Range("A21").Value = UCase(.Range("A13").Value)
                .Range("B21").Select
                .Range("A13").ClearContents
                .Range("A21").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                 Application.EnableEvents = True

Let me advise

Cell A21 is autmatically converted to uppercase after it was placed in cell A13
So does that help you.

Thanks

 

[Joe4]

You have got a lot of other stuff going on in your code which you haven't fully explained, and I have not attempted to analyze.

A simple solution would be to add the code we added (in red) at the top of your procedure, instead of the bottom, so it runs first.

 

[MARK858]

Just a silly question because of the With statement you have. What sheet is the Z21 on and which sheet have you got the code in?

 

[ipbr21054]

The sheet is called HONDA LIST

 

[RoryA]

If it skips that block then you didn't change Z21.

 

[Joe4]

The sheet is called HONDA LIST

Your code references "HONDA SHEET".

So, if there really are two different sheets in play here, then you need to clarify the following:
1. Which sheet is this VBA code attached to (which module is it in)?
2. Which sheet is this Z21 entry being made in?