Insert new row & apply Ucase
Page 1 of 5 123 ... LastLast
Results 1 to 10 of 44

Thread: Insert new row & apply Ucase

  1. #1
    Board Regular
    Join Date
    Nov 2010
    Posts
    2,379
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Insert new row & apply Ucase

    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
    Range("A6:H6").Value = UCase(Range("A6:H6").Value)
    End Sub
    Many Thanks
    I have learning difficulties so please be patient if i'm slow on the uptake,Thanks Very Much...

  2. #2
    Board Regular
    Join Date
    Jul 2011
    Posts
    475
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    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

  3. #3
    Board Regular
    Join Date
    Sep 2004
    Posts
    1,353
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    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
    There are people who work a lot and make many mistakes. There are people who work a little and make few mistakes. I know people who don't make any mistakes.

  4. #4
    Board Regular
    Join Date
    Jul 2011
    Posts
    475
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    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 by trunten; Aug 25th, 2019 at 12:31 PM.

  5. #5
    Board Regular
    Join Date
    Nov 2010
    Posts
    2,379
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    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
    I have learning difficulties so please be patient if i'm slow on the uptake,Thanks Very Much...

  6. #6
    Board Regular
    Join Date
    Jul 2011
    Posts
    475
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    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 by trunten; Aug 25th, 2019 at 12:38 PM.

  7. #7
    Board Regular
    Join Date
    Nov 2010
    Posts
    2,379
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    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
            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
    I have learning difficulties so please be patient if i'm slow on the uptake,Thanks Very Much...

  8. #8
    Board Regular
    Join Date
    Jul 2011
    Posts
    475
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    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 by trunten; Aug 25th, 2019 at 01:00 PM.

  9. #9
    MrExcel MVP Rick Rothstein's Avatar
    Join Date
    Apr 2011
    Location
    New Jersey, USA
    Posts
    35,085
    Post Thanks / Like
    Mentioned
    92 Post(s)
    Tagged
    33 Thread(s)

    Default Re: Insert new row & apply Ucase

    Quote Originally Posted by ipbr21054 View Post
    Code:
    Range("A6:H6").Value = UCase(Range("A6:H6").Value)
    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 by Rick Rothstein; Aug 25th, 2019 at 12:58 PM.
    Rick's "mini" blog... http://www.excelfox.com/forum/f22/
    .
    Want to post a small screen shot? See Part B here.

  10. #10
    Board Regular
    Join Date
    Nov 2010
    Posts
    2,379
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert new row & apply Ucase

    I did but thats the message i see.

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

    Code:
    setUndo = Target
    I have learning difficulties so please be patient if i'm slow on the uptake,Thanks Very Much...

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •