Visual Basic Programming Code Examples

Adding a selection-validation combo to an Excel Range Often it is useful to restrict the values a user can enter in a range. The following code demonstrates how to restrict a user to only entering values from a drop down combo box (which is populated from a specifed range or comma seperated list). See the "Test" routine at the bottom of this post. 'Purpose : Adds a validation rule to a range. This will only allow the user to select values for ' a range/cell from a combo. 'Inputs : rngToValidate The range of cells to add the validation rule to. ' vValues The range of values to populate the combo/drop down which the cells ' in rngToValidate can contain values from. ' OR a string containing a comma seperated list of values. ' [sInputTitle] The heading for the input title ' [sInputMessage] The heading for the input title ' [sErrorTitle] The title of the error message if the user enters incorrect data. ' [sErrorMessage] The error message if the user enters incorrect data. 'Outputs : Returns True on success. 'Notes : If you wish to use a range on a another sheet (i.e. a hidden sheet) then you ' can only do this if you use Range Name (i.e. Click Insert > Name > Define then ' add new named ranges) 'Revisions : Function RangeValidationSet(rngToValidate As Excel.Range, Optional vValues As Variant, Optional sInputTitle As String, Optional sInputMessage As String, Optional sErrorTitle As String, Optional sErrorMessage As String) As Boolean On Error Resume Next With rngToValidate.Validation 'Check to see if should delete validation If IsObject(vValues) = False Then Select Case Len(vValues) Case 0 'Remove the range validation .Delete RangeValidationSet = True Exit Function Case Is > 256 Debug.Print "Error in RangeValidationSet: Length of validation text exceeded 256 characters" RangeValidationSet = False Exit Function End Select End If 'Add a range validation .Delete 'Delete any existing validations On Error GoTo ErrFailed If TypeName(vValues) = "Range" Then .Add xlValidateList, xlValidAlertStop, xlBetween, "=" & vValues.Address Else .Add xlValidateList, xlValidAlertStop, xlBetween, vValues End If .IgnoreBlank = True .InCellDropdown = True .InputTitle = sInputTitle .InputMessage = sInputMessage .ErrorTitle = sErrorTitle .ErrorMessage = sErrorMessage If Len(sInputTitle + sInputMessage) Then .ShowInput = True Else .ShowInput = False End If If Len(sErrorTitle + sErrorMessage) Then .ShowError = True Else .ShowError = False End If End With RangeValidationSet = True Exit Function ErrFailed: Debug.Print "Error in RangeValidationSet: " & Err.Description RangeValidationSet = False End Function 'Demonstration routine Sub Test() '---Using a range to hold the validation values Range("A1").Value = "Yes" Range("A2").Value = "No" Range("A:A").Columns(1).Hidden = True If RangeValidationSet(Range("B:B"), Range("A1:A2")) Then 'Success MsgBox "Column B will now only allow YES/NO values", vbInformation End If '---Using a string to hold the validation values If RangeValidationSet(Range("C:C"), "YES,NO,DON'T CARE") Then 'Success MsgBox "Column C will now only allow YES,NO,DON'T CARE values", vbInformation End If End Sub