Insert new row & apply Ucase

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
2,838
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
 

trunten

Active Member
Joined
Jul 26, 2011
Messages
478
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,417
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
478
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
2,838
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
478
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
2,838
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
478
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
35,510
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
2,838
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]
 

Forum statistics

Threads
1,082,358
Messages
5,364,914
Members
400,815
Latest member
Joaquin Phoenix

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top