[SOLVED:] New to VBA and require assistance modifying code.

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.

Code:

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/

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.

Code:

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

Quote:

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

Code:

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

Quote:

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

Sorry P45cal, not heard of this before.

Quote:

Originally Posted by Aussiebear

Sorry P45cal, not heard of this before.

vbaexpress website not playing nicely.

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

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

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

Sorry i was not aware and wont do it Again

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

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

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.

Code:

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

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

try:

Code:

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:

Code:

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.

Quote:

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

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

1 Attachment(s)

Sample File

Quote:

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.

HI,

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

Code:

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