Copy Validation to next row

[Suzanne]

I have a spreadsheet with data validation drop-downs; the spreadsheet may
have 2 names or may have 200 names.

Need some help with code:

Where A1 = Name; B1 has validation dropdown

B2: If B1 <> "" (if there is a name) then copy A1 validation dropdown to B2

Thanks -- Suzanne

 

[Rick Rothstein \(MVP - VB\)]

I'm not entirely sure how you want to implement this, but the VBA statements
needed to copy the Validation List and Validation Properties from B1 to B2
would be this...

With Range("B2").Validation
.Delete
.Add Type:=xlValidateList, _
Formula1:=Range("B1").Validation.Formula1, _
AlertStyle:=Range("B1").Validation.AlertStyle
.ErrorTitle = Range("B1").Validation.ErrorTitle
.ErrorMessage = Range("B1").Validation.ErrorMessage
End With

Rick

 

[Suzanne]

My worksheet is something like this:

A B
1 NAME TYPE
2 Smith Admin
3 Jones Clerk
4 Roberts Admin
5 Adams Manager
etc.

COL B contains a validation drop-down
This worksheet will be used for various buildings; therefore, COL A could
contain 3 names or it could contain 100 names

I want to avoid having empty rows and I want to ensure if users enter more
than 100 names, the validation drop-downs will continue to be available.

Thanks very much...

Suzanne

 

[Rick Rothstein \(MVP - VB\)]

Give this code a try... I think it will do what you want:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ReEnableEvents
Application.EnableEvents = False
If Target.Row > 1 And Target.Count = 1 Then
If Target.Column = 1 Then
Target.Offset(0, 1).Validation.Delete
If Target.Value <> "" Then
With Target.Offset(0, 1).Validation
.Add Type:=xlValidateList, _
Formula1:=Range("$B$1").Validation.Formula1, _
AlertStyle:=Range("$B$1").Validation.AlertStyle
.ErrorTitle = Range("$B$1").Validation.ErrorTitle
.ErrorMessage = Range("$B$1").Validation.ErrorMessage
End With
End If
ElseIf Target.Column = 2 And Target.Offset(0, -1).Value = "" Then
MsgBox "Put something in " & Target.Offset(0, -1).Address & " first."
Target.Clear
Target.Select
End If
End If
ReEnableEvents:
Application.EnableEvents = True
End Sub

Rick

 

[Suzanne]

Thanks Rick... the formula appears to work for one column.

The example below was a poor example of what I have to work with... I
actually have data through COL "AM" but not all columns contain validation
drop-downs.

Can the code below be nudged to include the entire row?

 

[Rick Rothstein \(MVP - VB\)]

Do or can the other columns that do not have validation drop-downs... can
they have any other kind of validation (that must be retained)?

Rick

 

[Suzanne]

No... the other cells may contain a variety of data (i.e., some are
administrative data incl name, room# (may be "A" or "1" or "A1" or "1A"),
bldg#, etc; other cells contain technical data, e.g., equipment#, serial#,
etc. which have varying data input possibilities.

 

[Rick Rothstein \(MVP - VB\)]

Okay, give this code a try....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Answer As Long
Dim rCell As Range
Const Col_AM As Long = 39
On Error Resume Next
Application.EnableEvents = False
If Target.Row > 1 And Target.Count = 1 Then
If Target.Column = 1 Then
Target.Offset(0, 1).Resize(, Col_AM - 1).Validation.Delete
If Target.Value <> "" Then
For Each rCell In Target.Offset(0, 1).Resize(, Col_AM - 1)
With Cells(1, rCell.Column).Validation
rCell.Validation.Add Type:=xlValidateList, _
Formula1:=.Formula1, AlertStyle:=.AlertStyle
rCell.Validation.ErrorTitle = .ErrorTitle
rCell.Validation.ErrorMessage = .ErrorMessage
rCell.Validation.InputTitle = .InputTitle
rCell.Validation.InputMessage = .InputMessage
End With
Next
Else
Answer = MsgBox("Do you want to clear the data in this row?", _
vbQuestion Or vbYesNo Or vbDefaultButton2, "Clear Data?")
If Answer = vbYes Then Target.EntireRow.Clear
End If
ElseIf Target.Column >= 2 And Target.Column <= Col_AM And _
Target.Offset(0, 1 - Target.Column).Value = "" Then
MsgBox "Put something in " & Target.Offset(0, 1 - _
Target.Column).Address & " first."
Target.Clear
Target.Select
End If
End If
Application.EnableEvents = True
End Sub


Rick

 

[Suzanne]

Thanks Rick... I'll give this a try tomorrow morning... is there any chance
you can take a look at my "Validation code not working" problem???

Thanks again VERY much -- Suz

 

[Suzanne]

The formula didn't work as anticipated. Instead of copying down to the next
row, it copied down multiple rows, resulting #REF across the spreadsheet.

 

[Rick Rothstein \(MVP - VB\)]

The formula didn't work as anticipated. Instead of copying down to the

next
row, it copied down multiple rows, resulting #REF across the spreadsheet.

Can you explain what you did (the steps you took) to make this happen?

Rick