Insert Data Validation Using Subroutine
Data Validation creates a drop-down list of valid selections to be assigned to a cell's contents. The user clicks on an arrow to the right of the cell, and a list of possible choices is displayed. This process creates a more accurate method of data entry rather than manually entering the data. The following code shows how the calling program sends the subroutine the target worksheet and cell locations for the data validation selections. This is useful if new rows are inserted in a target worksheet and the developer wants to populate one or more of the cells with a validation object.
The code below illustrates how the calling program passes the argument (Which contains both the workbook and the worksheet cell reference) to the called subroutine, and the subroutine inserts the validation object into the worksheet cell specified by the calling parameter.
Program Code
Option Explicit
Sub InsertValidationObject()
' **********************************************************
' This program calls a subroutine to insert data validation
' in the worksheet specified in the call statement.
' It is useful because this sub can specify any workbook
' and any worksheet within that workbook
' **********************************************************
Dim wkbAffiliateCompensation As Workbook
Dim wksDataValidation As Worksheet
Dim wksComboBox As Worksheet
Dim wksCompensationDocument As Worksheet
Dim wksTargetWorksheet As Worksheet
Set wkbAffiliateCompensation = ThisWorkbook
Set wksDataValidation = wkbAffiliateCompensation.Sheets("CreateValidation")
Set wksComboBox = wkbAffiliateCompensation.Sheets("CreateComboBox")
Set wksCompensationDocument = wkbAffiliateCompensation.Sheets("Compensation Document")
Call InsertDataValidation(wksComboBox.Cells(50, 1))
End Sub
Sub InsertDataValidation(rngRangeToInsert As Range)
' **********************************************************
' Define Workbook and Worksheets
' **********************************************************
Dim wkbAffiliateCompensation As Workbook
Dim wksDataValidation As Worksheet
Dim wksComboBox As Worksheet
Dim wksCompensationDocument As Worksheet
Dim wksTargetWorksheet As Worksheet
' **********************************************************
' Define The Location & Number of the Validation Constants
' **********************************************************
Dim strValidationProfile As String
' **********************************************************
' Locate the Last Row of the Validation Constants
' **********************************************************
Dim lngLastRowOfCompensationServices As Long
' **********************************************************
' Activate the Workbook and Worksheet Constants
' **********************************************************
Set wkbAffiliateCompensation = ThisWorkbook
Set wksDataValidation = wkbAffiliateCompensation.Sheets("CreateValidation")
Set wksComboBox = wkbAffiliateCompensation.Sheets("CreateComboBox")
Set wksCompensationDocument = wkbAffiliateCompensation.Sheets("Compensation Document")
' **********************************************************
' Locate The Last Row of the Validation Constants
' **********************************************************
lngLastRowOfCompensationServices = wksCompensationDocument.Cells(wksCompensationDocument.Rows.Count, "A").End(xlUp).Row
' **********************************************************
' Identify The Cell To Insert The Data Validation
' **********************************************************
strValidationProfile = "='Compensation Document'!$A$4:$A$" & lngLastRowOfCompensationServices
' **********************************************************
' Update The Cell To Include Data Validation
' **********************************************************
With rngRangeToInsert.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=strValidationProfile
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Sub CopyDataValidation()
' **********************************************************
' Copy Validation Characteristics To New Cell
' **********************************************************
Selection.Copy
Range("B16").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub