Insert new row & apply Ucase

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Hi,

Can you advise please the correct way to apply Ucase for when i insert a new row each time at A6:H6

I have this code below but keep getting Run Time Error 13

Code:
Private Sub InsertNewRow_Click()Rows("6:6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A6").Select
Range("A6:H6").Font.Size = 18
Range("A4:H6").Font.Bold = True
Range("A6:H6").Interior.ColorIndex = 6
Range("A6:H6").Borders.LineStyle = xlContinuous
Range("A6:H6").Borders.Weight = xlThin
Range("A6:H6").HorizontalAlignment = xlCenter
Range("A6:H6").VerticalAlignment = xlCenter
Range("A6:H6").Name = "Calibri"
Range("A6:H6").RowHeight = 30
[COLOR=#ff0000]Range("A6:H6").Value = UCase(Range("A6:H6").Value)[/COLOR]
End Sub

Many Thanks
 
Please take a look at this then.

This works fine in respect of when i leave the cell it changes to uppercase.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)    With Target
        If .Column = 5 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
    End With
End Sub

So i then add the above code into my existing worksheet_change event code like shown below.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)Dim c As Range
  On Error GoTo AllowEvents
  If Target.Count > 1000 Then Exit Sub
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each c In Target
      If c.Row > 5 And c.Column = 2 Then
          If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
          Application.EnableEvents = False
          MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
          c.Value = ""
          c.Select
          Else
              c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3


        End If
      End If
    Next
        With Target
        If .Column = 5 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
AllowEvents:
  Application.EnableEvents = True
End With
End If
End Sub

When i now type the same name & leave the cell nothing happens in respect of changing the text to upper case
 
Last edited:
Upvote 0

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
When i now type the same name & leave the cell nothing happens in respect of changing the text to upper case
The code seems to work fine... the problem is you cannot see it because you turned screen updating off never turned it back on because of where you pasted your additional code. I have moved the screen updating statements to locations where they can function properly. See if this now works for you...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range
  On Error GoTo AllowEvents
  If Target.Count > 1000 Then Exit Sub
  Application.EnableEvents = False
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each c In Target
      If c.Row > 5 And c.Column = 2 Then
          If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
          MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
          c.Value = ""
          c.Select
          Else
              c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
          End If
      End If
    Next
    With Target
        If .Column = 5 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
AllowEvents:
    End With
  End If
  Application.EnableEvents = True
End Sub
 
Upvote 0
No still the same.
No error message.

I type steve & when i leave the cell its still steve as opposed to STEVE
 
Upvote 0
Maybe this is what you want.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim c As Range
   On Error GoTo AllowEvents
   If Target.Count > 1000 Then Exit Sub
   If Not Intersect(Target, Range("B:B")) Is Nothing Then
      Application.EnableEvents = False
      For Each c In Target
         If c.Row > 5 And c.Column = 2 Then
            If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
               MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
               c.Value = ""
               c.Select
            Else
               c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
            End If
         End If
      Next
      Application.EnableEvents = True
   End If
   With Target
      If .Column = 5 Then GoTo AllowEvents
      If .Count = 1 And Not .HasFormula Then
         Application.EnableEvents = False
         .Value = UCase(.Value)
         Application.EnableEvents = True
      End If
   End With
AllowEvents:
   Application.EnableEvents = True
End Sub
 
Upvote 0
That is it.

Works great.

Many thanks for you & the other members who helped with this.
 
Upvote 0
@ipbr21054
Comments such as this
I type steve & when i leave the cell its still steve as opposed to STEVE
tell nothing of any value.
You need to be more explicit, such as what cell are you entering the value.

Also comments such as this
Thanks but im going to wait for @DanteAmor
are verging on rude, especially to the members who are trying to help you. In future please do not make comments like this again.

Also constantly mentioning members who are not involved in the thread, could be considered as rude to the people trying to help & could also be considered as harassment.
Please refrain from this in the future, we are all volunteers giving what spare time we have. There is no guarantee that any particular member will be willing or able to help you when you need them.

I suggest that you take the time to refresh your memory regarding the rules of this site
Thanks
 
Last edited:
Upvote 0
No still the same.
No error message.

I type steve & when i leave the cell its still steve as opposed to STEVE
As it turns out, you had a few more things out of place. See it this works for you...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range
  On Error GoTo AllowEvents
  If Target.CountLarge > 1000 Then Exit Sub
  Application.EnableEvents = False
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each c In Target
      If c.Row > 5 And c.Column >= 2 And c.Column < 5 Then
          If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
              MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
              c.Value = ""
              c.Select
          Else
              If Not c.HasFormula Then
                  c.Value = UCase(c.Value)
              End If
              c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
          End If
      End If
    Next
  End If
AllowEvents:
  Application.EnableEvents = True
End Sub
 
Upvote 0
OK
I agree with what you have wrote & will take note.

I also get offended by people saying / mentioing things & i then mention my signature.
I dont have the same ability as most of the members here but i end up having to mention my downside of which for me is upsetting each time i have to do it.

Thanks
 
Upvote 0
Hi,
I have just noticed that the 10th character doesnt change red.

The uppercase works fine.
Sorry but only just spotted it.

I type in cell B 17 characters where the 10th character should be red but it stays black for some odd reason.

Code supplied.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)  Dim c As Range
  On Error GoTo AllowEvents
  If Target.Count > 1000 Then Exit Sub
   If Not Intersect(Target, Range("B:B")) Is Nothing Then
      Application.EnableEvents = False
      For Each c In Target
         If c.Row > 5 And c.Column = 2 Then
            If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
          MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
          c.Value = ""
          c.Select
          Else
                c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3


            End If
         End If
      Next
      Application.EnableEvents = True
   End If
   With Target
      If .Column = 6 Then GoTo AllowEvents
      If .Count = 1 And Not .HasFormula Then
         Application.EnableEvents = False
         .Value = UCase(.Value)
         Application.EnableEvents = True
      End If
   End With
AllowEvents:
   Application.EnableEvents = True
End Sub
 
Upvote 0
I have just noticed that the 10th character doesnt change red.
Using the code I posted in Message #27 ... it colors the 10th character red for me, so I am not sure why it is not doing that for you. Any chance you can post your workbook to DropBox and give us the sharing link they provide for your file so we can look at exactly what you are looking at? Make sure to delete or, if your formulas depend on them, replace with nonsense text, any sensitive information in your workbook.
 
Upvote 0

Forum statistics

Threads
1,214,912
Messages
6,122,204
Members
449,072
Latest member
DW Draft

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top