Apply macro to specific columns only

[lammatt145]

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:

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!

 

[nemmi69]

Not run it but try

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
'Updated by Ken Gardner 2022/07/11
'Update by Nemmi 2022/08/12 column range
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
If Target.Column >= 3 And Target.Column <= 11 Then 'C - K
    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
End If
Application.EnableEvents = True
End Sub

 

[lammatt145]

Thank you so much, that worked perfectly!

 

[nemmi69]

Your welcome