Recreate Data Validation
 

Hi, I have a workbook with lookup lists. A user may paste rows and then want
to pick from a lookup list for values not pasted. During the paste cells with
data validate may be overwritten. The problem is that I am unable to recreate
the data validation using code or even to manually after a code attempt.

I use a custom type to store the definition of the data validation located
in a sample cell.

Public Type typCellValidation
Formula1 As String
IgnoreBlank As Boolean
InCellDropdown As Boolean
InputTitle As String
ErrorTitle As String
InputMessage As String
ErrorMessage As String
ShowInput As Boolean
ShowError As Boolean
End Type

I use the following to store the example cell definition and then apply to
the destination range.

aLookup = Split(mcLookupList, "|")
For intLoop = 0 To UBound(aLookup())
Set rngSource = Range(aLookup(intLoop) & "Validation")
intColumn = rngSource.Column
Set rngDestination = Range(Cells(3, intColumn), Cells(lngLastRow,
intColumn))
'Get initial default values
With rngSource.Validation
cellValidation.Formula1 = .Formula1
cellValidation.IgnoreBlank = .IgnoreBlank
cellValidation.InCellDropdown = .InCellDropdown
cellValidation.InputTitle = .InputTitle
cellValidation.ErrorTitle = .ErrorTitle
cellValidation.InputMessage = .InputMessage
cellValidation.ErrorMessage = .ErrorMessage
cellValidation.ShowInput = .ShowInput
cellValidation.ShowError = .ShowError
End With
'Apply valuation rules
With rngDestination.Validation
.Delete
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:=cellValidation.Formula1
.IgnoreBlank = cellValidation.IgnoreBlank
.InCellDropdown = cellValidation.InCellDropdown
.InputTitle = cellValidation.InputTitle
.ErrorTitle = cellValidation.ErrorTitle
.InputMessage = cellValidation.InputMessage
.ErrorMessage = cellValidation.ErrorMessage
.ShowInput = cellValidation.ShowInput
.ShowError = cellValidation.ShowError
End With

DoEvents
Next intLoop

When I use Tools Data Validation to check, everything is as expected in
terms of settings. However, cells in the destination range do not display the
dropdown arrow to allow for selection from the list.

Any ideas to display the dropdown lookup list is appreciated.

Many thanks
Jonathan