lammatt145
New Member
- Joined
- Aug 12, 2022
- Messages
- 2
- Office Version
- 2016
- Platform
- Windows
Hello,
I am a novice excel user and I have used a pre-built macro to allow me to select multiple options from a list. The macro also allows me to remove selected entries by re-selecting them from the list. I only want this macro applied to specific columns - in this case columns C - K inclusive. Could someone help me edit my macro to do this?
Here's my macro:
Thank you!
I am a novice excel user and I have used a pre-built macro to allow me to select multiple options from a list. The macro also allows me to remove selected entries by re-selecting them from the list. I only want this macro applied to specific columns - in this case columns C - K inclusive. Could someone help me edit my macro to do this?
Here's my macro:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
'Updated by Ken Gardner 2022/07/11
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
Dim semiColonCnt As Integer
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
'If Not Application.Intersect(Target, xRng) Is Nothing Then
If Application.Intersect(Target, xRng) Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or xValue1 = xValue2 & ";" Or xValue1 = xValue2 & "; " Then ' leave the value if only one in list
xValue1 = Replace(xValue1, "; ", "")
xValue1 = Replace(xValue1, ";", "")
Target.Value = xValue1
ElseIf InStr(1, xValue1, "; " & xValue2) Then
xValue1 = Replace(xValue1, xValue2, "") ' removes existing value from the list on repeat selection
Target.Value = xValue1
ElseIf InStr(1, xValue1, xValue2 & ";") Then
xValue1 = Replace(xValue1, xValue2, "")
Target.Value = xValue1
Else
Target.Value = xValue1 & "; " & xValue2
End If
Target.Value = Replace(Target.Value, ";;", ";")
Target.Value = Replace(Target.Value, "; ;", ";")
If InStr(1, Target.Value, "; ") = 1 Then ' check for ; as first character and remove it
Target.Value = Replace(Target.Value, "; ", "", 1, 1)
End If
If InStr(1, Target.Value, ";") = 1 Then
Target.Value = Replace(Target.Value, ";", "", 1, 1)
End If
semiColonCnt = 0
For i = 1 To Len(Target.Value)
If InStr(i, Target.Value, ";") Then
semiColonCnt = semiColonCnt + 1
End If
Next i
If semiColonCnt = 1 Then ' remove ; if last character
Target.Value = Replace(Target.Value, "; ", "")
Target.Value = Replace(Target.Value, ";", "")
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
Thank you!