Apply different data validation to column based on matching column first cell value

[matt767]

data validation = (list, decimal, whole number, etc.)

I have a sheet with a column for products (called variant.id, column F), followed by 20 blank attribute columns (H:AA), followed by their corresponding allowed values columns (AG:AZ), with the attribute name as column headers for both. The allowed values are either a vertical list or a single cell word like 'integer', 'inches', 'ounces', etc. I would like to use VBA to apply data validation list to the attribute columns for which the corresponding allowed values are a list, and data validation decimal (0 to 1000) to the attribute columns whose corresponding allowed values are 'inches', 'ounces', 'pounds', etc. (with input message 'Enter a number in inches, ounces, etc.'), and data validation whole number (0 to 100) to columns with allowed values 'integer' (with input message 'Enter a whole number').

In the VBA I would like to apply the data validation for the attribute columns stretching down to 50K rows and then clear cell contents for cells which return '#N/A' for a vlookup with a concatenation of variant.id column with column header against a pre-made column (column AD) of that combo in between the attribute columns and allowed values columns.

I realize this is a complicated request and I appreciate any assistance you can offer.

 

[matt767]

I'm trying to use this code to clear cells from column I (the non-red cells):

Sub Clear_cells()
Dim rng As Range
Set rng = Range("$I$2:$I$50000")
Dim header As String
header = Range("I1").Value
Dim cel As Range
Dim id As String
Dim s As String
Dim val As Range
Set val = Range("bd1")
For Each cel In rng
id = cel.Offset(0, -3).Value
s = id & header
On Error Resume Next
val = Application.WorksheetFunction.VLookup(s, ActiveSheet.Range("$AD:$AD"), 1, False)
If Application.WorksheetFunction.IsNA(val) Then cel.Clear
Next
End Sub

but I get an "object variable or with block variable not set" error for line: id = cel.Offset(0, -3).Value
and s, id, and header = ""

Please help as I've exhausted my capabilities.

 

[matt767]

I used this code for the data validation:

Sub Validation()
Dim e As Integer
e = Application.Worksheets.Count
For o = 1 To e
Worksheets(o).Activate
Dim ws As Worksheet
Dim SrchRng As Range
Dim cel As Range
Dim list As Range
Dim list2 As Range
Dim list3 As Range
Dim num As Range
Dim num2 As Range
Set ws = ActiveSheet
Set SrchRng = Range("aq2:bt2")
Set num = Range("bu1")
Set num2 = Range("bv1")
For Each cel In SrchRng
Set list = Range(cel.Offset(0, 0), cel.Offset(1000, 0))
num = WorksheetFunction.CountA(list)
Set list3 = Range("$F3:$F50000")
num2 = WorksheetFunction.CountA(list3)
Set list2 = Range(cel.Offset(0, 0), cel.Offset(num - 1, 0))
    If InStr(1, cel.Value, "Inches") = 0 And InStr(1, cel.Value, "integer") = 0 And InStr(1, cel.Value, "Pounds") = 0 And InStr(1, cel.Value, "Ounces") = 0 And InStr(1, cel.Value, "Watts") = 0 And InStr(1, cel.Value, "all") = 0 Then
        Range(cel.Offset(0, -35), cel.Offset(num2, -35)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='" & ws.Name & "'!" & list2.Address
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If
Next cel
For Each cel In SrchRng
    If InStr(1, cel.Value, "Inches") > 0 Then
        Range(cel.Offset(0, -35), cel.Offset(num2, -35)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween, Formula1:="0", Formula2:="1000"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "Enter a number in inches."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    End If
Next cel
For Each cel In SrchRng
    If InStr(1, cel.Value, "integer") > 0 Then
        Range(cel.Offset(0, -35), cel.Offset(num2, -35)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:="0", Formula2:="100"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "Enter a whole number."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    End If
Next cel
For Each cel In SrchRng
    If InStr(1, cel.Value, "Pounds") > 0 Then
        Range(cel.Offset(0, -35), cel.Offset(num2, -35)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween, Formula1:="0", Formula2:="1000"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "Enter a number in pounds."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    End If
Next cel
For Each cel In SrchRng
    If InStr(1, cel.Value, "Ounces") > 0 Then
        Range(cel.Offset(0, -35), cel.Offset(num2, -35)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween, Formula1:="0", Formula2:="1000"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "Enter a number in ounces."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    End If
Next cel
For Each cel In SrchRng
    If InStr(1, cel.Value, "Watts") > 0 Then
        Range(cel.Offset(0, -35), cel.Offset(num2, -35)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween, Formula1:="0", Formula2:="1000"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "Enter a number in watts."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    End If
Next cel
For Each cel In SrchRng
    If InStr(1, cel.Value, "all") > 0 Then
        Range(cel.Offset(0, -35), cel.Offset(num2, -35)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:="0", Formula2:="10000"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "Enter text and/or numbers."
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    End If
Next cel
Next
End Sub

Still not sure how to do the remaining task I mentioned in earlier posts.

 

[matt767]

Should mention I added 10 more attribute columns in the final doc.