New to VBA and require assistance modifying code.

**SOUL** · 06-13-2024, 03:20 AM

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/

**jdelano** · 06-13-2024, 03:51 AM

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

**p45cal** · 06-13-2024, 03:53 AM

Originally Posted by SOUL

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** · 06-13-2024, 03:54 AM

Originally Posted by SOUL

Could someone assist me in modifying the code below so that it uses a line break instead of a comma delimited

**Aussiebear** · 06-13-2024, 03:57 AM

Sorry P45cal, not heard of this before.

**p45cal** · 06-13-2024, 04:08 AM

Originally Posted by Aussiebear

Sorry P45cal, not heard of this before.

vbaexpress website not playing nicely.

**p45cal** · 06-13-2024, 04:09 AM

Cross posted at least at https://chandoo.org/forum/threads/mu...own-box.57155/

**SOUL** · 06-13-2024, 04:20 AM

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

**SOUL** · 06-13-2024, 04:22 AM

Sorry P45cal. See now that i was supposed to post link. SORRY

**SOUL** · 06-13-2024, 04:27 AM

Sorry i was not aware and wont do it Again

**SOUL** · 06-13-2024, 04:36 AM

Sorry Again , for any inconvenienced I caused was not my intention and thank you for your assistance.

**SOUL** · 06-13-2024, 05:47 AM

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.

Originally Posted by jdelano

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

**jdelano** · 06-13-2024, 06:22 AM

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

**p45cal** · 06-13-2024, 07:39 AM

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** · 06-13-2024, 08:31 AM

Originally Posted by p45cal

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

**Paul_Hossler** · 06-13-2024, 06:26 PM

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

**SOUL** · 06-13-2024, 08:47 PM

Originally Posted by jdelano

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.

**SOUL** · 06-13-2024, 09:35 PM

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

Thread: New to VBA and require assistance modifying code.

Thread Tools

Display

New to VBA and require assistance modifying code.

Huge thanks

Thank for the assistance.

Sample File

Posting Permissions