EXCEL - Editing macro for selecting multiple items from a drop down list.

sbjmurrieta
sbjmurrieta used Ask the Experts™
on
I can add a name from the drop down menu, but if I go to try and remove a name, it only adds the name again. I am unable to delete any names.

Here's the VBA code I used. I also attached the excel spreadsheet. Thanks for your help!
 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column > 2 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

Open in new window

Calandar--1-.xls
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Author

Commented:
The sample worksheet is attached. Any ideas?
Brad Sims, CCNACyberSecurity Analyst

Commented:
You have the newVal and oldVal set to the same Target.Value.  Since it set to run each time there's a change in the worksheet, you cannot delete it since technically a deletion is still a change.

You'll need to add a clause that ensures there aren't two of the same names in any cell.  Or perhaps add a comparison exit that won't allow duplicate entries.
sbjmurrieta,

Please explain what you are wanting the Workseet_Change() macro to do as it is not at clear what it's purpose is.

If you use data validation then that should be enough to control the entry of specific data to those cells. You should not need a separate Workseet_Change() macro to check those cells. Thus please explain.

Patrick
Acronis in Gartner 2019 MQ for datacenter backup

It is an honor to be featured in Gartner 2019 Magic Quadrant for Datacenter Backup and Recovery Solutions. Gartner’s MQ sets a high standard and earning a place on their grid is a great affirmation that Acronis is delivering on our mission to protect all data, apps, and systems.

Author

Commented:
In the Attached Calendar, I want to be able to select Time Off names from the frop down menu.  When I need to select more than one name for any giving day, the macro adds the names together and puts them in the cell. This works well. Unfortunately, when I need to delete a name, I can not. It simply keeps adding  the name again. This makes the calendar useless. Is there any way to fix it?
Calandar--1-.xls

Author

Commented:
re: "You'll need to add a clause that ensures there aren't two of the same names in any cell.  Or perhaps add a comparison exit that won't allow duplicate entries."

Any ideas on how that would be written? I'm do not know how to write VBA code. Thanks for your help!

Brad Sims, CCNACyberSecurity Analyst

Commented:
Try this.  
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column > 2 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      If InStr(1, oldVal, newVal, vbTextCompare) <> 0 Then
      Target.Value = oldVal
      GoTo exitHandler
      End If
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

Open in new window

Author

Commented:
Dear :John15-16

I tried your cold and there is not a difference that I can see. It still will not allow me to delete a single name from the drop down list.
Brad Sims, CCNACyberSecurity Analyst

Commented:
I added the section below.  It will not allow you to enter a duplicate name so there should be no need to delete one.  If you need to be able to delete I will have to add another section of code, but I will have to research how that is going to work later.

Make sure you enter this code before you click on any cells, otherwise the old code will run instead of this.

      If InStr(1, oldVal, newVal, vbTextCompare) <> 0 Then
      Target.Value = oldVal
      GoTo exitHandler
      End If

Author

Commented:
Where would this code be entered? Does it replace any of the old code?

Author

Commented:
The issue is I would still need to be able to delete one if someone time off changed. So making it so you can add a person more than once is also helpful, but I would still need to be able to delete a name if necessary. Thanks for your help!
sbjmurrieta,

I have completely re-written the whole approach - see code below - it's in the attached file.

The list of staff is on Sheet2 - amend as needed. The names are loaded automatically into the Userform when a cell in the calendar is selected. I have by the way removed all the Data Validation dropdowns as the VBA takes care of it all.

Hope it helps

Patrick
In Module1:

Sub starter()
    UserForm1.Show
End Sub

In Sheet1 code pane:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim rng2 As Range
Dim celle As Range
Dim i As Long

With Sheets("Sheet1")
    Set rng2 = Range(.Cells(5, 3), .Cells(35, 3))
    For i = 0 To 25 Step 2
        Set rng = Range(.Cells(5, 3 + i), .Cells(35, 3 + i))
        Set rng2 = Union(rng2, rng)
    Next i

    If Not Intersect(rng2, Target) Is Nothing Then
        UserForm1.TextBox1.Text = Selection
        UserForm1.Show
    End If
End With

End Sub

In UserForm1 code pane:

Private Sub CommandButton1_Click()
    Selection.Delete
    Selection = UserForm1.TextBox1.Text
End Sub

Private Sub UserForm_Initialize()
Dim rng As Range
Dim celle As Range

With Sheets("Sheet2")
    Set rng = Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each celle In rng
    UserForm1.ListBox1.AddItem celle
Next celle

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i As Long
    
    For i = 0 To UserForm1.ListBox1.ListCount - 1
        If UserForm1.ListBox1.Selected(i) = True Then
            UserForm1.TextBox1.Text = UserForm1.TextBox1.Text & _
                IIf(UserForm1.TextBox1.Text <> "", ", ", "") & ListBox1.List(i)
        End If
    Next i
End Sub

Private Sub CommandButton2_Click()
    UserForm1.Hide
    Unload UserForm1
End Sub

Open in new window

Calendar-01.xls

Author

Commented:
This is very cool. Still wish I could have used drop down menus, as it is much cleaner. But this works. Thank you for all your help!

sbjmurrieta,

Thanks for the grade.

>Still wish I could have used drop down menus, as it is much cleaner.

Not too sure what you mean but in fact using Data Validation in many cells with a List that needs updating if someone joins or leaves is actually a pain. With using VBA in my solution you only have to make one change on Sheet2. I reckon that is much 'cleaner'.

Patrick

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial