CODEWITHSUNDEEP
vbaexcel
Markus Sacramento
Markus Sacramento

Reputation: 364

Excel VBA dropdownlist per row if value in AColumn

I´ve been searching for a solution to create a dropdownlist in ColumnC (with start from row 2) if there is value in ColumnA same row.
But all I was able to find is how to create one dropdownlist using VBA.

Sub DVraschwab()
  Dim myList$, i%
  myList = ""
  For i = 1 To 7
      myList = myList & "ListItem" & i & ","
  Next i
  myList = Mid(myList, 1, Len(myList) - 1)
  With Range("A5").Validation
      .Delete
      .Add _
      Type:=xlValidateList, _
      AlertStyle:=xlValidAlertStop, _
      Formula1:=myList
  End With
End Sub

Is this possible? And how should I begin?

The dropdownlist should contain "Yes" and "No" and No would be standard.

This is code that execute when I have written anythins in A Col:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub
  Application.EnableEvents = False 'to prevent endless loop
  On Error GoTo Finalize 'to re-enable the events

  For Each columnAcell In Target.Cells
      columnAcell.Offset(0, 3) = Mid(columnAcell, 2, 3)
      If IsEmpty(columnAcell.Value) Then columnAcell.Offset(0, 4).ClearContents
  Next

  Application.ScreenUpdating = False

  Dim w1 As Worksheet, w2 As Worksheet
  Dim c As Range, FR As Variant

  Set w1 = Workbooks("Excel VBA Test.xlsm").Worksheets("AP_Input")
  Set w2 = Workbooks("Excel VBA Test.xlsm").Worksheets("Datakom")

  For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
      FR = Application.Match(c, w2.Columns("A"), 0)
      If IsNumeric(FR) Then c.Offset(, 1).Value = w2.Range("B" & FR).Value
  Next c

  Call Modul1.DVraschwab
      If Target.Column = 1 Then
      If Target.Value = vbNullString Then
          Target.Offset(, 2).Clear
      End If
  End If

  Finalize:
  Application.EnableEvents = True
End Sub

The module I call is the dropdown you helped me with:

Sub DVraschwab()
  Dim myList As String, r As Range

  myList = "Yes,No"

  For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp))
      If r.Value <> vbNullString Then
          With r.Offset(, 2).Validation
              .Delete
              .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=myList
          End With
          r.Offset(, 2).Value = Split(myList, ",")(1)
      End If
  Next r
End Sub

Upvotes: 0

Views: 74

Answers (2)

SJR
SJR

Reputation: 23081

Do you mean like this? You basically just need a loop added to your code to check column A.

    Sub DVraschwab()

    Dim myList As String, r As Range

    myList = "Yes,No"

    For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If r.Value <> vbNullString Then
            With r.Offset(, 2).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=myList
            End With
            r.Offset(, 2).Value = Split(myList, ",")(1)
        End If
    Next r

    End Sub

'this in the relevant sheet module

    Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 1 and target.row>1 Then
        If Target.Value = vbNullString Then
            Target.Offset(, 2).Clear
        End If
    End If

    End Sub

Upvotes: 1

Variatus
Variatus

Reputation: 14383

This code will set the validation and write the default value in each cell.

Sub DVraschwab()
    ' 10 Jan 2018

    Const MyList As String = "Yes,No"

    Dim Rl As Long, R As Long

    With Worksheets("Duplicates")            ' replace with your sheet's name
        ' change column from "A" if not applicable
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        For R = 2 To Rl
            With .Cells(R, 3).Validation
                .Delete
                .Add Type:=xlValidateList, _
                     AlertStyle:=xlValidAlertStop, _
                     Formula1:=MyList
            End With
            .Cells(R, 3).Value = Split(MyList, ",")(1)
        Next R
    End With
End Sub

Upvotes: 0

Related Questions