Consulting

Results 1 to 4 of 4

Thread: UCase Help

  1. #1

    UCase Help

    I've created a spreadsheet for users to enter information about students. I've been asked to automatically reformat all text to UPPERCASE. I found the following code to do that but I don't know enough about VBA to insert it into my code. I've pasted my Project Explorer view below. Can someone kindly point out how to insert this into my existing code?

    Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Value = VBA.UCase(Target.Value)
    End Sub
    Here is my existing code which works just fine thanks to assistance from this forum
    Private Sub Worksheet_Change(ByVal Target As Range)
    Set myRng = Intersect(Columns(1), Target)
    If Not myRng Is Nothing Then
     For Each cll In myRng.Cells
       selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("counties2"), 2, False)
       If Not IsError(selectedNum) Then
         cll.Value = selectedNum
       End If
     Next cll
    End If
    
    
    'Code for Student Home Language (Column 13)
    Set myRng = Intersect(Columns(13), Target)
    If Not myRng Is Nothing Then
     For Each cll In myRng.Cells
       selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("Language"), 2, False)
       If Not IsError(selectedNum) Then
         cll.Value = selectedNum
       End If
     Next cll
    End If
    
    
    'Code for Active Student? (Column 19)
    Set myRng = Intersect(Columns(19), Target)
    If Not myRng Is Nothing Then
     For Each cll In myRng.Cells
       selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("Active"), 2, False)
       If Not IsError(selectedNum) Then
         cll.Value = selectedNum
       End If
     Next cll
    End If
    
    
    'Code for Instruction Type by Month Columns 20-29 (Note that I used Range option
    Set myRng = Intersect(Target, Range("T:AC"))
    'Set myRng = Intersect(Columns(20), Columns(29)), Target)
    If Not myRng Is Nothing Then
     For Each cll In myRng.Cells
       selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("InstructionType"), 2, False)
       If Not IsError(selectedNum) Then
         cll.Value = selectedNum
       End If
     Next cll
    End If
    Last edited by Paul_Hossler; 04-09-2021 at 05:06 PM.

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    1. I added CODE tags to your first post

    2. Continuing your approach, look at the <<<<<<<<<<<< lines

    3. Not totally sure about the columns to upper case, but you just need to tweak my ranges


    Private Sub Worksheet_Change(ByVal Target As Range)
    
    
    Application.EnableEvents = False    '   <<<<<<<<<<<<<<<<<<<<<<<<<<
    
    
    Set myRng = Intersect(Columns(1), Target)
    If Not myRng Is Nothing Then
      For Each cll In myRng.Cells
        selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("counties2"), 2, False)
        If Not IsError(selectedNum) Then
          cll.Value = selectedNum
        End If
      Next cll
    End If
    
    
    'Code for Student Home Language (Column 13)
    Set myRng = Intersect(Columns(13), Target)
    If Not myRng Is Nothing Then
      For Each cll In myRng.Cells
        selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("Language"), 2, False)
        If Not IsError(selectedNum) Then
          cll.Value = selectedNum
        End If
      Next cll
    End If
    
    
    'Code for Active Student? (Column 19)
    Set myRng = Intersect(Columns(19), Target)
    If Not myRng Is Nothing Then
      For Each cll In myRng.Cells
        selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("Active"), 2, False)
        If Not IsError(selectedNum) Then
          cll.Value = selectedNum
        End If
      Next cll
    End If
    
    
    'Code for Instruction Type by Month Columns 20-29 (Note that I used Range option
    Set myRng = Intersect(Target, Range("T:AC"))
    If Not myRng Is Nothing Then
      For Each cll In myRng.Cells
        selectedNum = Application.VLookup(cll.Value, Worksheets("Dropdowns").Range("InstructionType"), 2, False)
        If Not IsError(selectedNum) Then
          cll.Value = selectedNum
        End If
      Next cll
    End If
    
    
    'Code for making things uppercase       <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Set myRng = Intersect(Target, Range("B:E"))
    If Not myRng Is Nothing Then
      For Each cll In myRng.Cells
          cll.Value = UCase(cll.Value)
      Next cll
    End If
    
    
    Set myRng = Intersect(Target, Range("G:J"))
    If Not myRng Is Nothing Then
      For Each cll In myRng.Cells
          cll.Value = UCase(cll.Value)
      Next cll
    End If
    
    
    
    
    Set myRng = Intersect(Target, Range("Q:R"))
    If Not myRng Is Nothing Then
      For Each cll In myRng.Cells
          cll.Value = UCase(cll.Value)
      Next cll
    End If
    
    
    
    
    Application.EnableEvents = True     '   <<<<<<<<<<<<<<<<<<<<<<<<<<
    
    
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Unsolicited comment

    I think you could simplify the code

    ALso, you don't have a dropdown for school name


    Option Explicit
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rCell As Range
        Dim ws As Worksheet
        Dim v As Variant
        
        Set ws = Worksheets("Dropdowns")
        
        Application.EnableEvents = False
    
    
        For Each rCell In Target.Cells
            With rCell
                If .Row < 3 Then GoTo NextCell
        
                Select Case .Column
                    Case 1  '   county
                        v = Application.VLookup(.Value, ws.Range("counties2"), 2, False)
                        If Not IsError(v) Then .Value = v
                    
                    Case 13     '   Student Home Language
                        v = Application.VLookup(.Value, ws.Range("Language"), 2, False)
                        If Not IsError(v) Then .Value = v
        
                    Case 19 '   Active Student?
                        v = Application.VLookup(.Value, ws.Range("Active"), 2, False)
                        If Not IsError(v) Then .Value = v
            
                    Case 20 To 29   '   Instruction Type by Month
                        v = Application.VLookup(.Value, ws.Range("InstructionType"), 2, False)
                        If Not IsError(v) Then .Value = v
        
                    Case 2 To 5, 7 To 10, 17, 18
                        If Len(.Value) > 0 Then .Value = UCase(.Value)
                End Select
            End With
    NextCell:
        Next
    
    
        Application.EnableEvents = True
    
    
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #4
    Thanks so much for the help. The spreadsheet is working perfectly!

Posting Permissions

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