Insert new row & apply Ucase

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,388
Office Version
2007
Platform
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
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

trunten

Active Member
Joined
Jul 26, 2011
Messages
479
Not sure what you are trying to achieve here. Because you are inserting a new row then there will be no values to convert to upper case. If you want everything entered at row 6 to be upper case then you will need a worksheet change event to covert any values entered in A6:H6 to upper case. Eg:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("A6:H6")) Is Nothing Then
        Dim c As Range
        For Each c In Target
            c.Value = UCase(c.Value)
        Next c
    End If
End Sub
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,545
Office Version
2013, 2007
Platform
Windows
If you leave "Value" off, does that do it?
Code:
Range("A6:H6") = UCase(Range("A6:H6"))
BTW, I would do it slightly different (Delete the "Select" line)
Code:
With Range("A6:H6")
    .Font.Size = 18
    .Font.Bold = True
    ' continue with the rest
End With
 

trunten

Active Member
Joined
Jul 26, 2011
Messages
479
i'd probably do something like this just to try and keep some sort of undo stack intact.

For your insert rows sub:
Code:
Private Sub InsertNewRow_Click()
    Application.EnableEvents = False
    Rows("6:6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Range("A6:H6")
        .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
in a vba module:
Code:
Private stack As Collection


Public Sub setUndo(Optional ByRef r As Range)
    If stack Is Nothing Then Set stack = New Collection
    If Not r Is Nothing Then
        stack.Add Array(r, r.Formula)
    Else
        If stack.Count > 0 Then Application.onUndo "Undo typing in " & stack(stack.Count)(0).Address, "onUndo"
    End If
End Sub


Public Sub onUndo(Optional ByVal b As Boolean)
    If Not stack Is Nothing Then
        If stack.Count > 0 Then
            Dim rng As Range, r As Range, c As Range
            Dim v As Variant
            Dim i As Long, j As Long
            
            Set rng = stack(stack.Count)(0)
            v = stack(stack.Count)(1)
            i = 0: j = 0
            Application.EnableEvents = False
            For Each r In rng.Rows
                i = i + 1
                For Each c In r
                    j = j + 1
                    If IsArray(v) Then
                        c.Formula = v(i, j)
                    Else
                        c.Formula = v
                    End If
                Next c
            Next r
            Application.EnableEvents = True
            stack.Remove stack.Count
            Application.OnTime Now() + TimeValue("00:00:01"), "setUndo"
        End If
    End If
End Sub
in your worksheet module:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("A6:H6")) Is Nothing Then
        Dim c As Range
        Dim v As Variant
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        v = Target.Formula
        Application.Undo
        setUndo Target
        Target.Formula = v
        For Each c In Target
            c.Value = UCase(c.Value)
        Next c
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Application.onUndo "Undo typing in " & Target.Address, "onUndo"
    End If
End Sub
 
Last edited:

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,388
Office Version
2007
Platform
Windows
Afternoon,

I have the select piece so i can start typing straight away otherwise i need to select the cell before i can write.

The code in post #3 did not work for me so looking at the code in post #2 how would i add it to the existing Change event currently in use.

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
  End If
AllowEvents:
  Application.EnableEvents = True
 
End Sub
 

trunten

Active Member
Joined
Jul 26, 2011
Messages
479
just stick it at the end

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
    End If
    If Not Intersect(Target, Me.Range("A6:H6")) Is Nothing Then
        Application.ScreenUpdating = False
        For Each c In Target
            c.Value = UCase(c.Value)
        Next c
        Application.ScreenUpdating = True
    End If
    
AllowEvents:
    Application.EnableEvents = True
End Sub
Or if you decide to use the one with undo stack manipulation:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim v As Variant
    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
    End If
    If Not Intersect(Target, Me.Range("A6:H6")) Is Nothing Then
        Application.ScreenUpdating = False
        v = Target.Formula
        Application.Undo
        setUndo Target
        Target.Formula = v
        For Each c In Target
            c.Value = UCase(c.Value)
        Next c
        Application.ScreenUpdating = True
        Application.onUndo "Undo typing in " & Target.Address, "onUndo"
    End If
    
AllowEvents:
    Application.EnableEvents = True
End Sub
 
Last edited:

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,388
Office Version
2007
Platform
Windows
Using your stack manipulation code i get the message,
Compile error, Sub or function not defined.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)    Dim c As Range
    Dim v As Variant
    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
    End If
    If Not Intersect(Target, Me.Range("A6:H6")) Is Nothing Then
        Application.ScreenUpdating = False
        v = Target.Formula
        Application.Undo
        [COLOR=#ff0000]setUndo [/COLOR]Target
        Target.Formula = v
        For Each c In Target
            c.Value = UCase(c.Value)
        Next c
        Application.ScreenUpdating = True
        Application.OnUndo "Undo typing in " & Target.Address, "onUndo"
    End If
    
AllowEvents:
    Application.EnableEvents = True
End Sub
 

trunten

Active Member
Joined
Jul 26, 2011
Messages
479
you need to have added this code to a regular module first:

Code:
Private stack As Collection

Public Sub setUndo(Optional ByRef r As Range)
    If stack Is Nothing Then Set stack = New Collection
    If Not r Is Nothing Then
        stack.Add Array(r, r.Formula)
    Else
        On Error Resume Next
        If stack.Count > 0 Then Application.onUndo "Undo typing in " & stack(stack.Count)(0).Address, "onUndo"
        On Error GoTo 0
    End If
End Sub


Public Sub onUndo(Optional ByVal b As Boolean)
    If Not stack Is Nothing Then
        If stack.Count > 0 Then
            Dim rng As Range
            Dim v As Variant
            
            Set rng = stack(stack.Count)(0)
            v = stack(stack.Count)(1)
            Application.EnableEvents = False
            rng.Formula = v
            Application.EnableEvents = True
            stack.Remove stack.Count
            Application.OnTime Now() + TimeValue("00:00:01"), "setUndo"
        End If
    End If
End Sub
also, i have tweaked the change event code slightly to cope with row deletions:
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
    End If
    If Not Intersect(Target, Me.Range("A6:H6")) Is Nothing Then
        Application.ScreenUpdating = False
        Application.Undo
        setUndo Target
        Application.Undo
        For Each c In Target
            c.Value = UCase(c.Value)
        Next c
        Application.ScreenUpdating = True
        Application.onUndo "Undo typing in " & Target.Address, "onUndo"
    End If
    
AllowEvents:
    Application.EnableEvents = True
End Sub
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,056
Office Version
2010
Platform
Windows
Code:
[COLOR=#ff0000]Range("A6:H6").Value = UCase(Range("A6:H6").Value)[/COLOR]
To eliminate the error the above line generates, replace it with this one...
Code:
Range("A6:H6").Value = Evaluate("IF(A6:H6="""","""",UPPER(A6:H6))")
 
Last edited:

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,388
Office Version
2007
Platform
Windows
I did but thats the message i see.

If i add it like this it works but is it correct

Code:
[COLOR=#333333]setUndo = Target[/COLOR]
 

Watch MrExcel Video

Forum statistics

Threads
1,102,778
Messages
5,488,826
Members
407,658
Latest member
Arias610

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top