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

[Legend Dream]

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:

'==========================
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
'====================================

 

[sijpie]

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

 

[Legend Dream]

thanks Sijpie, i really appreciated, definitely interested, will be waiting.

 

[sijpie]

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]

The following should do the trick.

I have also cleaned up your original code a bit, see the comments.

'==========================
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
'====================================

 

[HelloKhritty]

The following should do the trick.

I have also cleaned up your original code a bit, see the comments.

'==========================
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
'====================================

Ohhh, Thank you very very much. This is so much help Sijpie