PDA

View Full Version : [SOLVED:] 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/muliple-selection-drop-down-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
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
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
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/muliple-selection-drop-down-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.


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
vbaexpress website not playing nicely.

I've added to the thread here to show what I've been getting:
http://www.vbaexpress.com/forum/showthread.php?71660-Site-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/showthread.php?71660-Site-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
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