A Build Validation Form

jstiene

Board Regular
Joined
Aug 5, 2005
Messages
222
I have a form that builds validation in a column while retaining cells original values
It only needs two buttons and three textboxes

I put my cursor in the header row of the column to build the list or set validation but you cold replace Hrow and Ccol with anything you want

A Listbutton to pull all the values in a column into a textbox called ValidationList
A BuildButon that loops down the column the cursor is in retaining the value, but building validation lists from the ValidationList textbox, (which could also be typed manually)
And a InputBox textbox where you could add an input message to the validation
And a ErrorBox textbox where you can add an error message to the validation

Private Sub ListButton_Click() 'Create list from column
Dim i As Integer, Lrow As Long, Cval As String, Add1 As String
Dim St2 As String, Ccol As Integer, Hrow As Integer
Hrow = Selection.Row
Ccol = Selection.Column
Lrow = Cells(Hrow, Ccol).SpecialCells(xlLastCell).Row
For i = Hrow + 1 To Lrow
Cval = Cells(i, Ccol).value
If InStr(1, St2, Cval, vbTextCompare) = 0 Then
St2 = St2 & Cval & ", "
End If
Next i
St2 = Left(St2, Len(St2) - 2)
Me.ValidationList.value = St2
End Sub

Private Sub BuildButton_Click() 'Build Validation
Dim i As Integer, Lrow As Long, Cval As String, Add1 As String
Dim LV As String, Ccol As Integer, Hrow As Integer, SH1 As String
LV = Me.ValidationList.value
SH1 = ActiveSheet.Name
Hrow = Selection.Row
Ccol = Selection.Column
Lrow = Cells(Hrow, Ccol).SpecialCells(xlLastCell).Row
For i = Hrow + 1 To Lrow
Cval = Cells(i, Ccol).value
Add1 = Cells(i, Ccol).Address(False, False)
If Len(LV) > 0 Then
With ActiveWorkbook.Sheets(SH1).Range(Add1).Validation
.Delete
.Add Type:=3, AlertStyle:=1, Operator:=1, Formula1:=LV
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
If Len(Me.ErrorBox.value) = 0 Then
.ErrorMessage = ""
Else
.ErrorMessage = Me.ErrorBox.value
End If

If Len(Me.InputBox.value) = 0 Then
.InputMessage = ""
Else
.InputMessage = Me.InputBox.value
End If


.ShowInput = True
.ShowError = True
End With
ActiveWorkbook.Sheets(SH1).Range(Add1).value = Cval
End If
Next i
MsgBox "Column has the same values but validation has been added."
End Sub
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Watch MrExcel Video

Forum statistics

Threads
1,122,842
Messages
5,598,396
Members
414,235
Latest member
sucosama

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top