If value selected before,Then remove from the data validation list VBA

Legend Dream

New Member
Joined
Oct 28, 2019
Messages
2
Hi All,

I hope that you can help me in this.

I have 2 sheets, using a list of data in the other sheet to enter the data into the first sheet, I’ve used a VBA code to get a searchable list with a combobox, what I need is to get the value removed from the data validation list if used before to prevent duplicates and to minimise the list as I’m using it.

anyone can help? i can upload a sample if needed.

Thanks for your time reading my question.


the VBA code i'm using is:
Code:
'==========================
Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
 
Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
    Cancel = True
    Application.EnableEvents = False
    'get the data validation formula
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.TempCombo.DropDown
  End If
 
errHandler:
  Application.EnableEvents = True
  Exit Sub
 
End Sub
Private Sub TempCombo_LostFocus()
  With Me.TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub
 
 
Private Sub TempCombo_KeyDown(ByVal _
     KeyCode As MSForms.ReturnInteger, _
     ByVal Shift As Integer)
  Select Case KeyCode
    Case 9 'Tab
      ActiveCell.Offset(0, 1).Activate
    Case 13 'Enter
      ActiveCell.Offset(1, 0).Activate
    Case Else
        'do nothing
  End Select
End Sub
'====================================
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,573
I sometimes do this. By using the Worksheet_Change event when the user has selected one of the validated entries, the macro stores the current validation entries in an array and then loops through the array to remove the used entry. (or you can do this directly with the range, but an array is very fast). Then you write the array back to the sheet.

If you need code, you will have to wait till mid next week. Let me know
 

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,573
A few questions:

  1. Do you have more than one validations where you want to delete an entry after selection? ie Are there more columns with different validation sets?
  2. Are the validation sets built from ranges, or entered as text in the dialogbox?
 

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,573
The following should do the trick.

I have also cleaned up your original code a bit, see the comments.
Rich (BB code):
'==========================
Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Dim sValRng As String
 
'Set cboTemp = ws.OLEObjects("TempCombo") '// no need to do this , _
                                            just use the object TempCombo itself
    With TempCombo
        'clear and hide the combo box
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    On Error GoTo errHandler    'if there is no validation, the code will error out
    If Target.Validation.Type = 3 Then
        'the cell contains a data validation list
        'cancel the double click
        Cancel = True
        
        'get the data validation formula
        sValRng = Target.Validation.Formula1
        'remove leading '='
        sValRng = Right(sValRng, Len(sValRng) - 1)
        
        With TempCombo
          'show the combobox with the list
          .Visible = True
          .Left = Target.Left
          .Top = Target.Top
          .Width = Target.Width + 5
          .Height = Target.Height + 5
          .ListFillRange = sValRng
          .LinkedCell = Target.Address
          .Activate
            'open the drop down list automatically
          .DropDown
        End With
    End If
 
errHandler:
    On Error GoTo 0    '<<<< always reset the errorhandler !!!
    Application.EnableEvents = True
    Exit Sub
 
End Sub


Private Sub TempCombo_LostFocus()
    
    With Me.TempCombo
        If .ListIndex > -1 Then
            ' user has selected item
            RemoveFromValidation .ListIndex, .ListFillRange
        End If
        .Top = 10
        .Left = 10
        .Width = 0
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
        .Value = ""
    End With
End Sub
 
Private Sub RemoveFromValidation(iItem As Integer, sValRName)
    Dim vOrig, vNew
    Dim i As Integer, j As Integer
    Dim lR As Long
    Dim sVRAddress As String
    
    'read validation range in to array
    vOrig = Range(sValRName).Value
    ReDim vNew(1 To UBound(vOrig, 1), 1 To UBound(vOrig, 2))
    j = 1
    ' copy the values in vOrig to vNew, except the selected item
    For i = 1 To UBound(vOrig, 1)
        If i <> iItem + 1 Then
            vNew(j, 1) = vOrig(i, 1)
            j = j + 1
        End If
    Next i
    ' copy vNew to the sheet overwriting the original values
    Range(sValRName).Value = vNew
    'Now reset the named range to the shorter table
    With ActiveWorkbook.Names(sValRName)
        sVRAddress = .RefersTo
        lR = Right(sVRAddress, Len(sVRAddress) - InStrRev(sVRAddress, "$"))
        .RefersTo = Left(sVRAddress, InStrRev(sVRAddress, "$")) & lR - 1
    End With
End Sub
 
Private Sub TempCombo_KeyDown(ByVal _
     KeyCode As MSForms.ReturnInteger, _
     ByVal Shift As Integer)
  Select Case KeyCode
    Case 9 'Tab
      ActiveCell.Offset(0, 1).Activate
    Case 13 'Enter
      ActiveCell.Offset(1, 0).Activate
    Case Else
        'do nothing
  End Select
End Sub
'====================================
 

Forum statistics

Threads
1,089,391
Messages
5,407,970
Members
403,175
Latest member
Zaibass

This Week's Hot Topics

  • help please
    SORRY NOT ANY GOOD AT EXCEL SO HELP WOULD BE MUCH APPRECIATED this formula is in a sheet called ignore...
  • two formulas needed
    Hello, I'll try my best to explain this: First formula needed in Sheet1 cell A2: If Sheet1 cell B2 = Sheet2 cell B2 then return a 1. If not then...
  • Dynamic Counts
    Good afternoon, we are tidying up some data & the data seems to be growing quicker than we are tidying it up! What we confirm (by reviewing it...
  • Help Excel formula eliminate duplicate values and keep only 2 identical rows.
    as picture below column A has a duplicate value. but the values are not the same as the rule. sometimes 4 rows, sometimes 10 rows or 7 or 9...
  • Macro Compile Error Sub or Function not defined
    Hello, I am trying to run macros from a validation list, all macros have been created and run perfectly on there own but I'm getting a compile...
  • Last row combined with Current Region VBA
    I'm generally happy finding the last row of data through something like Lastrow = Cells(Rows.Count, "D").End(xlUp) but I don't always receive data...
Top