Trigger Code by Dropdown

**rachaelgoldman1** · 09-06-2013, 10:33 AM

Hey everyone,

I have a VBA Code which moves the entire row to the second worksheet if it contains the word "Closed" in column A. I was wondering if someone could help me make the code refer to a drop down list which I will create. For some reason, when I create the drop down list for Column A, the code no longer works. Below is the code.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("A2:A9")) Is Nothing Then Exit Sub
 If Target.Count > 1 Then Exit Sub
 If Target = "" Then Exit Sub
 Dim NR As Long
 With Application
 .EnableEvents = False
 .ScreenUpdating = False
 Select Case Target.Value
 Case "Closed"
 Range("A" & Target.Row & ":M" & Target.Row).Copy Worksheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
 Target.EntireRow.Delete Shift:=xlUp
 End Select
 .EnableEvents = True
 .ScreenUpdating = True
 End With
 End Sub

Any help would be greatly appreciated!

Thanks!

**mehmetcik** · 09-07-2013, 10:31 AM

Hi

I played with your code and I think that this is what you are trying to do:-

Select a value displayed Listbox A1.

Move that entry to "Completed"


Private Sub Worksheet_Change(ByVal Target As Range)
EnableEvents = False
On Error GoTo 200
 If Intersect(Target, Range("A1")) Is Nothing Then GoTo 200
 If Target.Count > 1 Or Target = "" Then GoTo 200
 
If Target.Value > 0 Then

'Select all cells on Sheet 1.  You can reduce this ti a single or a single row
temp = Right(Range("A1").Validation.Formula1, Len(Range("A1").Validation.Formula1) - 1)

Range(temp).Select

 'This is where the macro Learns where to look
    Set rngLook = Selection

'This is where the macro Learns what to look For
    strValueToPick = Target.Value

' The macro finds all occurrances of the search string in the selection
    With rngLook
        Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngPicked = rngFind
            Do
                Set rngPicked = Union(rngPicked, rngFind)
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With

TR = rngPicked.Row()

 Range("A" & TR & ":M" & TR).Copy Worksheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
 Rows(TR).EntireRow.Delete Shift:=xlUp
End If

200   Range("A1").Select

    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$B$2:$B$" & Range("B" & Rows.Count).End(xlUp).Row
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

 EnableEvents = True

 End Sub