HOW IT WORKS

Given a  selection of cells with a drop down  list with  data validation from a specific source of input, the functions and  subroutines indicated below will allow you to:

  1. Make multiple selections of values from each cell
  2. Avoid duplicates in case of wrong choice
  3. Have all your selected options numerically sorted

HOW THE SPREASHEET LOOKS LIKE

The fraction of the spreadsheet indicated in the screenshot below (as an example) shows the multiple selections for the VLAN column (Column E). All the selected options are separated by the pipe delimiter (|) and are nicely numerically sorted with no duplicates allowed:

 

 

NOTE

WHAT'S NEXT

  1. Modify the script based on the cells you want to be sensed (have a look at the Worksheet_Change subroutine)
  2. Make sure to apply (if you like) data validation with source of numbers
  3. Just copy all the functions and subroutines below within the Microsoft Visual Basic for Application space linked to your spreadsheet

 

 

VB Script
Edit|Remove
Sub Quick_Sort(ByRef arr As Variant, first As Long, last As Long) 
   
  Dim vCentreVal As Variant, vTemp As Variant 
   
  Dim lTempLow As Long 
  Dim lTempHi As Long 
  lTempLow = first 
  lTempHi = last 
   
  vCentreVal = arr((first + last) \ 2) 
  Do While lTempLow <= lTempHi 
   
    Do While arr(lTempLow) < vCentreVal And lTempLow < last 
      lTempLow = lTempLow + 1 
    Loop 
     
    Do While vCentreVal < arr(lTempHi) And lTempHi > first 
      lTempHi = lTempHi - 1 
    Loop 
     
    If lTempLow <= lTempHi Then 
     
        ' Swap values 
        vTemp = arr(lTempLow) 
 
        arr(lTempLow) = arr(lTempHi) 
        arr(lTempHi) = vTemp 
       
        ' Move to next positions 
        lTempLow = lTempLow + 1 
        lTempHi = lTempHi - 1 
       
    End If 
     
  Loop 
   
  If first < lTempHi Then Quick_Sort arr, first, lTempHi 
  If lTempLow < last Then Quick_Sort arr, lTempLow, last 
   
End Sub 
Function Array_To_String(ByRef arr As Variant, first As Long, last As LongAs String 
     
    ' Input: array of Integer values 
    ' Output: array of String values 
    Dim lTempLow As Long 
    Dim lTempHi As Long 
    Dim tempString As String 
     
    tempString = "" 
     
    If first = last Then 
        ' If the array is empty 
        Array_To_String = arr(first) 
    Else 
        ' Otherwise 
        lTempLow = first 
        lTempHi = last 
        Do While lTempLow <= lTempHi 
            If tempString = "" Then 
                tempString = arr(lTempLow) 
            Else 
                tempString = tempString & " | " & arr(lTempLow) 
            End If 
            lTempLow = lTempLow + 1 
        Loop 
        Array_To_String = tempString 
    End If 
     
End Function 
Sub Str_Array_To_Long_Array(ByRef arr As Variant, first As Long, last As Long) 
 
    ' Input: array of String values 
    ' Output: array of Long values 
    Dim lTempLow As Long 
    Dim lTempHi As Long 
    Dim tempLong As Long 
     
    lTempLow = first 
    lTempHi = last 
    Do While lTempLow <= lTempHi 
        MsgBox "imhere" 
        tempLong = arr(lTempLow) 
        arr(lTempLow) = CLng(tempLong) 
        lTempLow = lTempLow + 1 
    Loop 
 
End Sub 
Sub Sort_Array_Of_Strings(ByRef arr As Variant, first As Long, last As Long) 
     
    ' Input: array of String values 
    ' Output: array of String values sorted as it was made by numbers 
     
    ' Define a temporary array of Long values of the same size of the "arr" array 
    Dim tempNumArray() As Long 
    ReDim Preserve tempNumArray(first To last) 
     
    ' Transfer string values from the "arr" array into a temporary array of numbers only 
    For i = LBound(arr) To UBound(arr) 
        tempNumArray(i) = CLng(arr(i)) 
    Next i 
     
    ' Sort the temporary array of numbers 
    Quick_Sort tempNumArray, LBound(tempNumArray), UBound(tempNumArray) 
         
    ' Transfer numbers from the temporary array to the "arr" array 
    For i = LBound(tempNumArray) To UBound(tempNumArray) 
        arr(i) = CStr(tempNumArray(i)) 
    Next i 
     
End Sub 
Private Sub Worksheet_Change(ByVal Target As Range) 
 
    ' This sub allows multiple selections of vLANs (avoiding duplicates and sorting everything numerically) 
    Dim oldValue As String 
    Dim newValue As String 
    Dim tempStrngArr() As String 
     
    Application.EnableEvents = True 
    On Error GoTo Exitsub 
     
    If Target.Column = 5 And Target.Row > 5 And Target.Row < 226 Then 
        ' If modified cell is not in the "right" place 
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then 
            GoTo Exitsub 
        Else: 
            If Target.Value = "" Then 
                ' User has reset the Target.Value cell 
                GoTo Exitsub 
            Else 
                ' User has entered a real value 
                Application.EnableEvents = False 
                newValue = Target.Value 
                Application.Undo 
                oldValue = Target.Value 
                 
                If oldValue = "" Then 
                    ' If Target.Value cell was empty before user entered value 
                    Target.Value = newValue 
                Else 
                    ' Otherwise, if previous value of Target.Value cell was NOT empty, create an array whose cells 
                    ' are the values of the current modified cell. Attention: this array is made of string values! 
                    tempStrngArr = Split(oldValue, " | ") 
                     
                    'Append newValue at the end of current array (only if not duplicated) 
                    Dim duplicated As Boolean 
                    duplicated = False 
                    For i = LBound(tempStrngArr) To UBound(tempStrngArr) 
                        If tempStrngArr(i) = newValue Then 
                            duplicated = True 
                        End If 
                    Next i 
                    If Not duplicated Then 
                        ' Append newValue into the current tempStrngArr array 
                        ReDim Preserve tempStrngArr(LBound(tempStrngArr) To UBound(tempStrngArr) + 1) 
                        tempStrngArr(UBound(tempStrngArr)) = newValue 
                         
                        ' Sort this array of string values as they were numbers (so that 10 < 100 and not the other way around) 
                        If UBound(tempStrngArr) > 0 Then 
                            Sort_Array_Of_Strings tempStrngArr, LBound(tempStrngArr), UBound(tempStrngArr) 
                        End If 
                     
                        ' Convert the array just sorted into a unique string and assign it to Target.Value 
                        Target.Value = Array_To_String(tempStrngArr, LBound(tempStrngArr), UBound(tempStrngArr)) 
                    End If 
                End If 
            End If 
        End If 
    End If 
     
Exitsub: 
    Application.EnableEvents = True 
        
End Sub