Consulting

Results 1 to 18 of 18

Thread: New to VBA and require assistance modifying code.

  1. #1
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location

    New to VBA and require assistance modifying code.

    Hi,

    Could someone assist me in modifying the code below so that it uses a line break instead of a comma delimited, I want to insert this into different cells, not just one specific one.

    
    Private Sub Worksheet_Change(ByVal Target As Range)
    'Code by Sumit Bansal from https://trumpexcel.com
    ' To allow multiple selections in a Drop Down List in Excel (without repetition)
    '  Edited to allow deselection of item (courtesy of Jamie Counsell)
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Target.Address = "$A$14" Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        ElseIf Target.Value = "" Then
            GoTo Exitsub
        Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            Target.Value = Newvalue
           If Oldvalue <> "" Then
                If Newvalue <> "" Then
                    If InStr(1, Oldvalue, ", " & Newvalue & ",") > 0 Then
                        Oldvalue = Replace(Oldvalue, Newvalue & ", ", "") ' If it's in the middle with comma
                        Target.Value = Oldvalue
                        GoTo jumpOut
                    End If
                    If Left(Oldvalue, Len(Newvalue & ", ")) = Newvalue & ", " Then
                        Oldvalue = Replace(Oldvalue, Newvalue & ", ", "") ' If it's at the start with comma
                        Target.Value = Oldvalue
                        GoTo jumpOut
                    End If
                    If Right(Oldvalue, Len(", " & Newvalue)) = ", " & Newvalue Then
                        Oldvalue = Left(Oldvalue, Len(Oldvalue) - Len(", " & Newvalue)) ' If it's at the end with a comma in front of it
                        Target.Value = Oldvalue
                        GoTo jumpOut
                    End If
                    If Oldvalue = Newvalue Then ' If it is the only item in string
                        Oldvalue = ""
                        Target.Value = Oldvalue
                        GoTo jumpOut
                    End If
                    Target.Value = Oldvalue & ", " & Newvalue
                End If
    jumpOut:
            End If
        End If
    End If
    Application.EnableEvents = True
    Exitsub:
    Application.EnableEvents = True
    End Sub
    
    [/CODE]

    I have posted this on the following Group, https://chandoo.org/forum/threads/mu...own-box.57155/
    Last edited by SOUL; 06-13-2024 at 04:25 AM.

  2. #2
    This is straight replacement of comma with the keyword used in VBA for a line feed vbCrLf. Also, when posting code, used the # button, then paste your code between the two bracketed code markers.

    Also tweaked the formatting a bit to make it easier to read.

    What are you using this code for, given a line feed is much different than a comma there is likely a better way of doing whatever string dance you need.

    Private Sub Worksheet_Change(ByVal Target As Range)
        'Code by Sumit Bansal from https://trumpexcel.com
        ' To allow multiple selections in a Drop Down List in Excel (without repetition)
        ' Edited to allow deselection of item (courtesy of Jamie Counsell)
        
        Application.EnableEvents = True
        
        On Error GoTo Exitsub
        
        If Target.Address = "$A$14" Then
            If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            
                GoTo Exitsub
            ElseIf Target.Value = "" Then
                GoTo Exitsub
            Else
                Application.EnableEvents = False
                Newvalue = Target.Value
                Application.Undo
                Oldvalue = Target.Value
                Target.Value = Newvalue
                
                If Oldvalue <> "" Then
                    If Newvalue <> "" Then
                        If InStr(1, Oldvalue, vbCrLf & Newvalue & vbCrLf) > 0 Then
                            Oldvalue = Replace(Oldvalue, Newvalue & vbCrLf, "") ' If it's in the middle with comma
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
            
                        If Left(Oldvalue, Len(Newvalue & vbCrLf)) = Newvalue & vbCrlf Then
                            Oldvalue = Replace(Oldvalue, Newvalue & vbCrLf, "") ' If it's at the start with comma
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
                        
                        If Right(Oldvalue, Len(vbCrLf & Newvalue)) = vbCrLf & Newvalue Then
                            Oldvalue = Left(Oldvalue, Len(Oldvalue) - Len(vbCrLf & Newvalue)) ' If it's at the end with a comma in front of it
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
            
                        If Oldvalue = Newvalue Then ' If it is the only item in string
                            Oldvalue = ""
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
            
                        Target.Value = Oldvalue & vbCrLf & Newvalue
                    End If
    jumpOut:
                End If
            End If
        End If
        
        Application.EnableEvents = True
    Exitsub:
        Application.EnableEvents = True
    End Sub

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,911
    Quote Originally Posted by SOUL View Post
    Could someone assist me in modifying the code below so that it uses a line break instead of a comma delimited
    Private Sub Worksheet_Change(ByVal Target As Range)
    'Code by Sumit Bansal from https://trumpexcel.com
    ' To allow multiple selections in a Drop Down List in Excel (without repetition)
    ' Edited to allow deselection of item (courtesy of Jamie Counsell)
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Target.Address = "$A$14" Then
      If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo Exitsub
      ElseIf Target.Value = "" Then
        GoTo Exitsub
      Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        Target.Value = Newvalue
        If Oldvalue <> "" Then
          If Newvalue <> "" Then
            If InStr(1, Oldvalue, vbLf & Newvalue & vbLf) > 0 Then
              Oldvalue = Replace(Oldvalue, Newvalue & vbLf, "") ' If it's in the middle with comma
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Left(Oldvalue, Len(Newvalue & vbLf)) = Newvalue & vbLf Then
              Oldvalue = Replace(Oldvalue, Newvalue & vbLf, "") ' If it's at the start with comma
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Right(Oldvalue, Len(vbLf & Newvalue)) = vbLf & Newvalue Then
              Oldvalue = Left(Oldvalue, Len(Oldvalue) - Len(vbLf & Newvalue)) ' If it's at the end with a comma in front of it
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Oldvalue = Newvalue Then              ' If it is the only item in string
              Oldvalue = ""
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            Target.Value = Oldvalue & vbLf & Newvalue
          End If
    jumpOut:
        End If
      End If
    End If
    Application.EnableEvents = True
    Exitsub:
    Application.EnableEvents = True
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,911
    Quote Originally Posted by SOUL View Post
    Could someone assist me in modifying the code below so that it uses a line break instead of a comma delimited
    Last edited by p45cal; 06-13-2024 at 04:10 AM.

  5. #5
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,189
    Location
    Sorry P45cal, not heard of this before.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  6. #6
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,911
    Quote Originally Posted by Aussiebear View Post
    Sorry P45cal, not heard of this before.
    vbaexpress website not playing nicely.

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,911

  8. #8
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location

    Huge thanks

    Thanks for the above code. i am trying to insert this into sevaral cells. Have you any idea how i could achieve this. I have tried adding in ( If Target.Address = "$A$14, $A$30, $A$40, $A$50 " Then) but i think i am missing the plot here.

    Regards
    SOUL
    Last edited by Aussiebear; 06-13-2024 at 05:29 PM. Reason: Removed unnecessary quoting

  9. #9
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location
    Sorry P45cal. See now that i was supposed to post link. SORRY

  10. #10
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location
    Sorry i was not aware and wont do it Again

  11. #11
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location
    Sorry Again , for any inconvenienced I caused was not my intention and thank you for your assistance.

  12. #12
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location

    Thumbs up Thank for the assistance.

    Hi Jdelano,

    Once again a huge thanks for the assistance.

    I am busy with a project for a homeless shelter project i am busy with. I have 4 cells that will utilize this function.

    Quote Originally Posted by jdelano View Post
    This is straight replacement of comma with the keyword used in VBA for a line feed vbCrLf. Also, when posting code, used the # button, then paste your code between the two bracketed code markers.

    Also tweaked the formatting a bit to make it easier to read.

    What are you using this code for, given a line feed is much different than a comma there is likely a better way of doing whatever string dance you need.

    Private Sub Worksheet_Change(ByVal Target As Range)
        'Code by Sumit Bansal from https://trumpexcel.com
        ' To allow multiple selections in a Drop Down List in Excel (without repetition)
        ' Edited to allow deselection of item (courtesy of Jamie Counsell)
        
        Application.EnableEvents = True
        
        On Error GoTo Exitsub
        
        If Target.Address = "$A$14" Then
            If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            
                GoTo Exitsub
            ElseIf Target.Value = "" Then
                GoTo Exitsub
            Else
                Application.EnableEvents = False
                Newvalue = Target.Value
                Application.Undo
                Oldvalue = Target.Value
                Target.Value = Newvalue
                
                If Oldvalue <> "" Then
                    If Newvalue <> "" Then
                        If InStr(1, Oldvalue, vbCrLf & Newvalue & vbCrLf) > 0 Then
                            Oldvalue = Replace(Oldvalue, Newvalue & vbCrLf, "") ' If it's in the middle with comma
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
            
                        If Left(Oldvalue, Len(Newvalue & vbCrLf)) = Newvalue & vbCrlf Then
                            Oldvalue = Replace(Oldvalue, Newvalue & vbCrLf, "") ' If it's at the start with comma
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
                        
                        If Right(Oldvalue, Len(vbCrLf & Newvalue)) = vbCrLf & Newvalue Then
                            Oldvalue = Left(Oldvalue, Len(Oldvalue) - Len(vbCrLf & Newvalue)) ' If it's at the end with a comma in front of it
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
            
                        If Oldvalue = Newvalue Then ' If it is the only item in string
                            Oldvalue = ""
                            Target.Value = Oldvalue
                            GoTo jumpOut
                        End If
            
                        Target.Value = Oldvalue & vbCrLf & Newvalue
                    End If
    jumpOut:
                End If
            End If
        End If
        
        Application.EnableEvents = True
    Exitsub:
        Application.EnableEvents = True
    End Sub

  13. #13
    Can you show an example of the string you're trying to parse? Having context will aid in giving a better response to you.

  14. #14
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,911
    try:
    Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Target.Cells.Count = 1 And Not Intersect(Target, Range("$A$14, $A$30, $A$40, $A$50")) Is Nothing Then
      If Intersect(Cells.SpecialCells(xlCellTypeAllValidation), Target) Is Nothing Then
        GoTo Exitsub
      ElseIf Target.Value = "" Then
        GoTo Exitsub
      Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        Target.Value = Newvalue
        If Oldvalue <> "" Then
          If Newvalue <> "" Then
            If InStr(1, Oldvalue, vbLf & Newvalue & vbLf) > 0 Then
              Oldvalue = Replace(Oldvalue, Newvalue & vbLf, "") ' If it's in the middle with comma
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Left(Oldvalue, Len(Newvalue & vbLf)) = Newvalue & vbLf Then
              Oldvalue = Replace(Oldvalue, Newvalue & vbLf, "") ' If it's at the start with comma
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Right(Oldvalue, Len(vbLf & Newvalue)) = vbLf & Newvalue Then
              Oldvalue = Left(Oldvalue, Len(Oldvalue) - Len(vbLf & Newvalue)) ' If it's at the end with a comma in front of it
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Oldvalue = Newvalue Then              ' If it is the only item in string
              Oldvalue = ""
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            Target.Value = Oldvalue & vbLf & Newvalue
          End If
    jumpOut:
        End If
      End If
    End If
    Application.EnableEvents = True
    Exitsub:
    Application.EnableEvents = True
    End Sub
    ps. This original line doesn't do what it's intended to:
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    because when target is a single cell the whole sheet is looked at so it only tests if the sheet contains at least one cell with data validation in it.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  15. #15
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,911
    Quote Originally Posted by p45cal View Post
    vbaexpress website not playing nicely.
    I've added to the thread here to show what I've been getting:
    http://www.vbaexpress.com/forum/show...-error-message

  16. #16
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,748
    Location
    There's been a lot of that going around lately

    http://www.vbaexpress.com/forum/show...-error-message

    I get that message occasionally (1 out of 8-9 times) when I try to access the site

    Don't know if it's related to DOW or TOD
    ---------------------------------------------------------------------------------------------------------------------

    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

  17. #17
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location

    Sample File

    Quote Originally Posted by jdelano View Post
    Can you show an example of the string you're trying to parse? Having context will aid in giving a better response to you.
    I have attached a sample file.

    The red blocks are the ones that require the drop down lists.
    Attached Files Attached Files

  18. #18
    VBAX Regular
    Joined
    Jun 2024
    Posts
    9
    Location
    HI,

    I did theses changes this morning and it seems to work. I am still designing and testing.

    Private Sub Worksheet_Change(ByVal Target As Range)'Code by Sumit Bansal from https://trumpexcel.com
    ' To allow multiple selections in a Drop Down List in Excel (without repetition)
    ' Edited to allow deselection of item (courtesy of Jamie Counsell)
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Not Intersect(Target, Range("A6, A10, A14, A18")) Is Nothing Then
      If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
      ElseIf Target.Value = "" Then
        GoTo Exitsub
      Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        Target.Value = Newvalue
        If Oldvalue <> "" Then
          If Newvalue <> "" Then
            If InStr(1, Oldvalue, vbLf & Newvalue & vbLf) > 0 Then
              Oldvalue = Replace(Oldvalue, Newvalue & vbLf, "") ' If it's in the middle with comma
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Left(Oldvalue, Len(Newvalue & vbLf)) = Newvalue & vbLf Then
              Oldvalue = Replace(Oldvalue, Newvalue & vbLf, "") ' If it's at the start with comma
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Right(Oldvalue, Len(vbLf & Newvalue)) = vbLf & Newvalue Then
              Oldvalue = Left(Oldvalue, Len(Oldvalue) - Len(vbLf & Newvalue)) ' If it's at the end with a comma in front of it
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            If Oldvalue = Newvalue Then              ' If it is the only item in string
              Oldvalue = ""
              Target.Value = Oldvalue
              GoTo jumpOut
            End If
            Target.Value = Oldvalue & vbLf & Newvalue
          End If
    jumpOut:
        End If
      End If
    End If
    Application.EnableEvents = True
    Exitsub:
    Application.EnableEvents = True
    End Sub

Posting Permissions

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