CODEWITHSUNDEEP
vbaexceldrop-down-menu
Ana
Ana

Reputation: 1586

Create a dropdown list when a row is added using VBA

I want to write a macro that does as follows: If you enter a value under column A, it gives a dropdown list in the same row under column B.

I have written a peice which works for the first time. But the problem is when I run it, if there is already a dropdown list in some cells, it breaks!

Sub Macro2()
Dim cell As Range

'If a value is listed
  For Each cell In ActiveSheet.Range("A2:A1000")
    If cell.Value <> "" Then
        cell.Offset(0, 1).Select
        If Selection = Empty Then
            With Selection.Validation
                'add list box
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=Sheet1!A2:A20"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If
  Next cell
End Sub

I should add that I cannot delete the content in column B, because I do not want to lose the work already there.

Upvotes: 1

Views: 1335

Answers (2)

teylyn
teylyn

Reputation: 35935

Why don't you clear existing data validation before adding the new one?

Along these lines: 

        With Selection.Validation
            ' delete existing
            .Delete
            'add list box
            .Add Type etc.

The Validation.Delete does the same thing as clicking "Clear All" in the data validation dialog. No cell content gets changed or removed.

enter image description here

Upvotes: 0

BruceWayne
BruceWayne

Reputation: 23283

Here's a solution that will just delete a validation, then add back. Also, I removed the use of .Select, which can cause errors.

Dim isValid As Boolean

Sub Macro2()
Dim cell As Range

'If a value is listed
  For Each cell In ActiveSheet.Range("A2:A1000")
    If cell.Value <> "" Then
        testIfValidation cell.Offset(0, 1)
        If IsEmpty(cell.Offset(0, 1)) And Not isValid Then
            With cell.Offset(0, 1).Validation
                'add list box
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=Sheet1!A2:A20"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If
  Next cell
End Sub

Private Sub testIfValidation(ByVal cel As Range)
Dim X As Variant
On Error Resume Next
X = cel.Validation.Type
On Error GoTo 0
If IsEmpty(X) Then
    Debug.Print cel.Address & " has no validation"
    isValid = False
Else
    isValid = True
End If
End Sub

I updated this with a test to see if a cell has validation. If it does, it'll skip it. Otherwise, proceed as usual.

Upvotes: 2

Related Questions