Excel and VB scripts

DazzaL

New Member
Joined
Oct 10, 2023
Messages
1
Office Version
  1. 2021
Platform
  1. Windows
Hi Forum Legends

Let me start by saying I am very new to VB scripts, and I am currently working through basic online training. So, I apologise for my lack of skills at this stage.

I've created an Excel spreadsheet that provides a daily job scheduled. There can be multiple jobs in one day, and I have specified each job in a seperate row. The information to be populated is in columns of Job Name and Team Member/s that will attend the job. I have created a drop-down list with the names of the team members and added a VB script (thanks to YouTube) to allow multiple names to be selected in a Cell.

As I say there are multiple Jobs across a day, and I want to prohibit the ability to choose a Team Member twice in any of the Team Member cells that apply to that day. In other words, a Team Member, can only be at one job in any day.

The script/code to allow multiple selections in a Cell is below. The Target.Column refer to multiple days (Mon, Tue, Wed etc) across the spreadsheet with column 6 and 14 and 15 (and so on) being the column for Team Members. As mentioned above, what I need to do is add code that allows the multiple Team Member selection but limits it to once in any column.

Any support the Forum can would be massively appreciated.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 6 Or Target.Column = 7 Or Target.Column = 14 Or Target.Column = 15 Or Target.Column = 22 Or Target.Column = 23 Or Target.Column = 30 Or Target.Column = 31 Or Target.Column = 38 Or Target.Column = 39 Or Target.Column = 46 Or Target.Column = 47 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

Thanks

Dazza
 
Last edited by a moderator:

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Forum statistics

Threads
1,223,888
Messages
6,175,207
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top