Insert new row & apply Ucase
Page 4 of 5 FirstFirst ... 2345 LastLast
Results 31 to 40 of 44

Thread: Insert new row & apply Ucase

  1. #31
    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 will need to look at this tomorrow now.
    Thanks.

  2. #32
    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

    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 by ipbr21054; Aug 26th, 2019 at 04:36 AM.
    I have learning difficulties so please be patient if i'm slow on the uptake,Thanks Very Much...

  3. #33
    MrExcel MVP Rick Rothstein's Avatar
    Join Date
    Apr 2011
    Location
    New Jersey, USA
    Posts
    35,103
    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
    Here is a link to download the file.

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

    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).
    Rick's "mini" blog... http://www.excelfox.com/forum/f22/
    .
    Want to post a small screen shot? See Part B here.

  4. #34
    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


  5. #35
    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

    have a look at this:
    https://www.dropbox.com/s/zftk15fcs0...EST3.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 by trunten; Aug 26th, 2019 at 08:42 AM.

  6. #36
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,756
    Post Thanks / Like
    Mentioned
    65 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Insert new row & apply Ucase

    Quote Originally Posted by ipbr21054 View Post
    Maybe @DanteAmor can assist please.

    This is what i have left the code as.

    I just need to have it in Ucase A6:H6

    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.
    Regards Dante Amor

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

    Default Re: Insert new row & apply Ucase

    Quote Originally Posted by ipbr21054;5331756Please try this.

    [url
    https://www.dropbox.com/s/lvc80zjfjm7mmle/TEST3.xlsm?dl=0[/url]
    In looking at your sample worksheet... is your goal to make all text entered by the user upper case (names, VINs, Models, etc.)?
    Rick's "mini" blog... http://www.excelfox.com/forum/f22/
    .
    Want to post a small screen shot? See Part B here.

  8. #38
    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

    Hi,
    Yes it is
    I have learning difficulties so please be patient if i'm slow on the uptake,Thanks Very Much...

  9. #39
    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

    Have a look at the workbook I linked to on Dropbox

  10. #40
    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

    Quote Originally Posted by trunten View Post
    Have a look at the workbook I linked to on Dropbox
    With regards that file is the code you show already applied to it ?
    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
  •