Insert new row & apply Ucase

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,832
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
 
Sort by date Sort by votes

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Hi,
Here we go,

This code below works in respect of once leaving a cell the text is changed to uppercase BUT 10th character Red does not work.

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
      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

This code below works in respect of 10th character Red but no Ucase code applied

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

Here is a link to download the file.
Thanks


http://www.mediafire.com/file/s8hes55i241jy74/TEST3.xlsm/file




 
Last edited:
Upvote 0
ipbr21054 said:
Here is a link to download the file.
[FONT=&]
[/FONT]http://www.mediafire.com/file/s8hes55i241jy74/TEST3.xlsm/file
[FONT=&]
[/FONT]
Click to expand...
Why do people insist on using these off-beat file sharing sites? Besides offering ads that look like download buttons, the actual download button brought up an ad but it did not bring up your file. My suggestion is to use DropBox... it is safe, free and no confusing ads. If you do, I'll look at the file when I wake up (I'm going to sleep now).
 
Upvote 0
have a look at this:
https://www.dropbox.com/s/zftk15fcs062s8z/mrexcel_TEST3.xlsm?dl=0

code in workbook:

regular VBA module:
Code: 
Option Explicit


Public Sub InsertNewRow_Click()
    Application.EnableEvents = False
    Rows("7:7").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Range("A7:H7")
        .Font.Size = 18
        .Font.Bold = True
        .Interior.ColorIndex = 6
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Name = "Calibri"
        .RowHeight = 30
    End With
    Application.EnableEvents = True
End Sub


Private Sub sortColumn(ByVal colNum As Long)
    Dim x As Long
    
    Application.ScreenUpdating = False
    On Error GoTo clean_exit
    With Sheets("MC LIST")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A7:H" & x).Sort key1:=.Cells(7, colNum), order1:=xlAscending, Header:=xlGuess
    End With
    ActiveWorkbook.Save
    Sheets("MC LIST").Range("A7").Select
clean_exit:
    Application.ScreenUpdating = True
End Sub


Public Sub SortCustomerButton_Click()
    sortColumn 1
End Sub


Public Sub SortVinButton_Click()
    sortColumn 2
End Sub


Public Sub SortMakeButton_Click()
    sortColumn 3
End Sub


Public Sub SortModelButton_Click()
    sortColumn 4
End Sub


Public Sub SortYearButton_Click()
    sortColumn 5
End Sub


Public Sub SortItemBoughtButton_Click()
    sortColumn 6
End Sub


Public Sub SortChipButton_Click()
    sortColumn 7
End Sub


Public Sub SortCountryButton_Click()
    sortColumn 8
End Sub

worksheet module:
Code: 
Option Explicit


Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    On Error GoTo clean_exit
    With Range("A5:H5")
        .Interior.ColorIndex = 2
        .Font.Size = 24
        .RowHeight = 36
    End With
    With Range("A7:H40")
        .Font.Size = 18
        .RowHeight = 30
    End With
    With Range("A4:H40")
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Name = "Calibri"
    End With
    Range("A5:H40").Font.Bold = True
    Range("A1:H4").Interior.ColorIndex = 1
    Range("A7").Select
clean_exit:
    Application.ScreenUpdating = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "H"


'   *** Specify start row ***
    myStartRow = 7
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Highlight the row and column that contain the active cell
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
    Target.Interior.Color = vbGreen


    Application.EnableEvents = False
    Select Case Mid(Range("B7").Value, 10, 1)
    Case Is = "S"
            Range("E7").Value = "1995"
    Case Is = "T"
            Range("E7").Value = "1996"
    Case Is = "V"
            Range("E7").Value = "1997"
    Case Is = "W"
            Range("E7").Value = "1998"
    Case Is = "X"
            Range("E7").Value = "1999"
    Case Is = "Y"
            Range("E7").Value = "2000"
    Case Is = "1"
            Range("E7").Value = "2001"
    Case Is = "2"
            Range("E7").Value = "2002"
    Case Is = "3"
            Range("E7").Value = "2003"
    Case Is = "4"
            Range("E7").Value = "2004"
    Case Is = "5"
            Range("E7").Value = "2005"
    Case Is = "6"
            Range("E7").Value = "2006"
    Case Is = "7"
            Range("E7").Value = "2007"
    Case Is = "8"
            Range("E7").Value = "2008"
    Case Is = "9"
            Range("E7").Value = "2009"
    Case Is = "A"
            Range("E7").Value = "2010"
    Case Is = "B"
            Range("E7").Value = "2011"
    Case Is = "C"
            Range("E7").Value = "2012"
    Case Is = "D"
            Range("E7").Value = "2013"
    Case Is = "E"
            Range("E7").Value = "2014"
    Case Is = "F"
            Range("E7").Value = "2015"
    Case Is = "G"
            Range("E7").Value = "2016"
    Case Is = "H"
            Range("E7").Value = "2017"
    Case Is = "J"
            Range("E7").Value = "2018"
    Case Is = "K"
            Range("E7").Value = "2019"
    End Select
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each c In Target
        If c.Row > 6 And c.Column < 9 And Not IsEmpty(c) Then
            If Not c.HasFormula Then
                c.Value = UCase(c.Value)
            Else
                c.Formula = Replace(c.Formula, "=", "=UPPER(") & ")"
            End If
        End If
    Next c
    
    If Target.CountLarge > 1000 Then GoTo AllowEvents
    
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        For Each c In Intersect(Target, Range("B:B"))
            If c.Row > 6 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
                    GoTo AllowEvents
                Else
                    c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                End If
            End If
        Next c
    End If
    
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 0
ipbr21054 said:
Maybe @DanteAmor can assist please.

This is what i have left the code as.

I just need to have it in Ucase A6:H6
Click to expand...


Hello @ipbr21054, I am flattered by your comment and I also appreciate your trust. But I assure you that I don't know all the answers, in this forum there are excellent experts.
You too must be patient and respect the help others are providing.
 
Upvote 0
ipbr21054;5331756Please try this. [url said:
https://www.dropbox.com/s/lvc80zjfjm7mmle/TEST3.xlsm?dl=0[/url]
Click to expand...
In looking at your sample worksheet... is your goal to make all text entered by the user upper case (names, VINs, Models, etc.)?
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Use the majority of an existing working code in new project advice
Replies
1
Views
221
ipbr21054
I
I
  • Solved
Cell above is selected when i duplicate row
Replies
2
Views
369
ipbr21054
I
H
  • Question Question
Save and Close Excel after a 15min inactivity.
Replies
4
Views
784
Hopey87
H
J
  • Question Question
Applying VBA to other cells
Replies
2
Views
474
NoSparks
N
I
  • Question Question
Add ID number next to customer row from userform transfer
Replies
2
Views
324
Joe4
Joe4

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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