Datavalidation with shrinking non blank values
 

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

' range C5:C12 will get validation dropdown after macro is run
' G5:G12- list of items required in drop down
'H5:H12 will have formula to determine selection - =IF(COUNTIF($C$5:$C$12,G5),"",G5) --enter this formula in G5 and drag till G12

Dim t As Integer, j As Integer, intLastRow As Integer, introw As Integer
Dim keycells As Range
Dim txt As String
Set keycells = Range("C5:C12")

If Not Application.Intersect(keycells, Range(Target.Address)) Is Nothing Then

intLastRow = 12
For introw = 5 To intLastRow
If Not IsEmpty(Cells(introw, 8)) Then
txt = txt & Cells(introw, 8) & ","
End If
Next introw

txt = Left(txt, Len(txt) - 1)
With Range("C5:C12").Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=txt
End With
End If

End Sub

Datavalidation with shrinking non blank values
 

Hi,

Am Fri, 22 Aug 2014 13:31:43 -0700 (PDT) schrieb Abhijeet Gudur:

' range C5:C12 will get validation dropdown after macro is run
' G5:G12- list of items required in drop down
'H5:H12 will have formula to determine selection - =IF(COUNTIF($C$5:$C$12,G5),"",G5) --enter this formula in G5 and drag till G12

in a standard module:

Sub Validation()
With Sheets("Sheet1")
With .Range("C5:C12").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=$G$5:$G$12"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
.Range("H5:H12").Formula = "=IF(COUNTIF($C$5:$C$12,G5),"""",G5)"
End With
End Sub



Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional