0

I utilized the code by Sumit Bansal at trumpexcel.com, however, the code doesn't seem to work. It is supposed to select more than one of the texts from the drop down without repetition. The drop down is for cells C8, C22, C36, until C134. Here is the code, thanks in advance.

Option Explicit

Private Sub DropDown(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
Dim x As Double

Application.EnableEvents = True
On Error GoTo Exitsub
For x = 1 To 10
    If Target.Address = Worksheets("BSOAP").Range("C" & (14 * x - 6)) Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        GoTo Exitsub
        Else: If Target.Value = "" Then GoTo Exitsub Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                If InStr(1, Oldvalue, Newvalue) = 0 Then
                    Target.Value = Oldvalue & ", " & Newvalue
                Else:
                    Target.Value = Oldvalue
                End If
            End If
        End If
    End If
Next x
Application.EnableEvents = True

Exitsub:
Application.EnableEvents = True

End Sub
A Cohen
  • 458
  • 7
  • 26
  • What exactly is the issue? is there a specific error? if so on what line, what error message? or is it simply unexpected behaviour? More information is required. – Zerk Oct 05 '17 at 15:53
  • @Zerk, It is just not selecting more than one from the list. – A Cohen Oct 05 '17 at 15:55
  • Given the sub depends on a target range and you've not showed us what range you provide as the source we'd be guessing. How are you calling the sub and what are you providing it? – Zerk Oct 05 '17 at 16:00
  • @Zerk, I apologize, I do not fully understand your question. I am extremely new to VBA and the creator this code did not fully explain the logic. – A Cohen Oct 05 '17 at 16:03
  • Apart from being arbitrarily named Dropdown the sub doesn't explicity do anything related to a dropdown box. Without seeing how it is used, what it is used with and your exact intentions for what you want it to do then it's impossible to help. – Zerk Oct 05 '17 at 16:09
  • @Zerk, I want to be able to select more than 1 selection from the drop down list which has been already applied to the the cells that I stated, `C8` `C22` etc. I thought that I referenced it in the line `If Target.Address = Worksheets("BSOAP").Range("C" & (14 * x - 6)) Then` – A Cohen Oct 05 '17 at 16:14
  • At first glance, your code seems like it could work, but as Zerk noted, it is impossible to tell why it is not working for you without more information. If you step through your code using F8, at what point does it stop working as intended? – TheEngineer Oct 05 '17 at 18:12
  • @TheEngineer I cannot run it, I'm unsure why? – A Cohen Oct 05 '17 at 19:11
  • Based on what I see on the link you provided, the code has to be placed in the `Worksheet_Change` event to work. – braX Oct 05 '17 at 19:17
  • @braX What do you mean? – A Cohen Oct 05 '17 at 19:19
  • It clearly starts with this: `Private Sub Worksheet_Change(ByVal Target As Range)` and you must have changed it to say `Dropdown` instead, so it's no longer part of any event. Start over with the original code (dont change anything) and place it in the correct place. – braX Oct 05 '17 at 19:21
  • @braX, I changed it but it still didn't work. – A Cohen Oct 05 '17 at 19:24
  • Probably because you didnt put it in the right place. It needs to be part of the `Worksheet`, not in a `Module`, not in the `Workbook`. – braX Oct 05 '17 at 19:27
  • @braX, It is in the worksheet, Do I have to name the worksheet "Change" or change the `Private Sub Worksheet_BSOAP(ByVal Target As Range)`? – A Cohen Oct 05 '17 at 19:32
  • No, dont change anything until you get it to work. If I were you, I would re-read the instructions on the page you linked to. It walks you thru each step. – braX Oct 05 '17 at 19:34
  • @braX, Does it matter if there's more code above it? It shouldn't right? – A Cohen Oct 05 '17 at 19:40
  • It should matter, no. seriously tho, follow the instructions on that website very carefully, do everything exactly like they say to with no exception, including the exact cells the tutorial uses. Other than that, I'm not sure what you are doing wrong, as all I can do at this point is take wild guesses. – braX Oct 05 '17 at 19:41
  • @ACohen, you are trying to pilot an airplane, when all you have is a driver's license – jsotola Oct 05 '17 at 19:52
  • It works if I use 'If Target.Address = "$C$8" Then`. But I need it for the cells I specified and I don't know of another way to work it. – A Cohen Oct 05 '17 at 19:59
  • Did my answer below work for you? – TheEngineer Oct 18 '17 at 14:24

1 Answers1

1

All you need to do is leave the code exactly as it was given and place it in your worksheet, with the following modifications:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

'Code by Sumit Bansal from https://trumpexcel.com
'Modified by TheEngineer from https://stackoverflow.com/
' To Select Multiple Items from a Drop Down List in Excel

Dim Oldvalue As String
Dim Newvalue As String
Dim i As Long
Dim b As Boolean
Dim arr(1 To 10) As String

For i = 1 To 10
    arr(i) = "$C$" & (14 * i - 6)
Next i

On Error GoTo Exitsub
If Contains(arr, Target.Address) Then
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
    Else: If Target.Value = "" Then GoTo Exitsub Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        If Oldvalue = "" Then
            Target.Value = Newvalue
        Else
            Target.Value = Oldvalue & ", " & Newvalue
        End If
    End If
End If

Exitsub:
Application.EnableEvents = True
End Sub

Function Contains(arr, v) As Boolean
Dim rv As Boolean, lb As Long, ub As Long, i As Long
    lb = LBound(arr)
    ub = UBound(arr)
    For i = lb To ub
        If arr(i) = v Then
            rv = True
            Exit For
        End If
    Next i
    Contains = rv
End Function

The Function was found here: Matching values in string array

This will allow you to select multiple items from the dropdown lists in the ten cells you referenced.

It is worth noting that this code uses the Undo function, so any time you use it to select multiple items, you will lose your ability to Undo anything before that point.

TheEngineer
  • 1,205
  • 1
  • 11
  • 19
  • I apologize for the lack of response. I misunderstood my supervisors want, he didn't want this, rather one item on the list that says "All Item". I apologize again. – A Cohen Oct 19 '17 at 14:03
  • No worries. I'm glad you were able to solve your problem. If this answer satisfies the requirements of the question that was asked, please mark it as the correct answer. – TheEngineer Oct 19 '17 at 14:31