Copy and Delete Row if Validation Equals

[helpexcel]

Hi,

I have a data range on Sheet 1 in Columns A:G and in Column H I have a validation list. What I would like to do is if "Bingo" is selected from the validation list, than i want to copy that row from A:G and paste it in sheet 2 starting in row 5. I can then use .clearcontents and Sort to clean the list up.

Any help is appreciated. Thanks!

 

[JLGWhiz]

try this

Sub bingo()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1") 'Edit sheet name
Set sh2 = Sheets("Sheet2") 'Edit sheet name
sh1.Range("H2", sh1.Cells(Rows.Count, 8).End(xlUp)).AutoFilter 1, "Bingo"
sh1.Range("A3", sh1.Cells(Rows.Count, 1).End(xlUp).Offset(, 6)).SpecialCells(xlCellTypeVisible).Copy sh2.Range("A5")
sh1.AutoFilterMode = False
End Sub

 

[helpexcel]

The range is static, so I made some changes, but it's not copying correctly. The data starts on row 3 sheet1.

Sub bingo()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1") 'Edit sheet name
Set sh2 = Sheets("Sheet2") 'Edit sheet name
sh1.Range("H3:H15").AutoFilter 1, "Bingo"
sh1.Range("A3:A15").Offset(, 6)).SpecialCells(xlCellTypeVisible).Copy sh2.Range("A5")
sh1.AutoFilterMode = False
End Sub

 

[helpexcel]

This works great, if you are doing a batch at a time. But is there a way to make it live, so that as soon as "Bingo" is selected the row is copied over?

Sub bingo()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("sheet1") 'Edit sheet name
Set sh2 = Sheets("sheet2") 'Edit sheet name


sh1.Range("A2:H15").AutoFilter 9, "LOST"
Range("A3:G15").SpecialCells(xlCellTypeVisible).Copy
sh2.Range("A5").PasteSpecial
Range("A3:H15").SpecialCells(xlCellTypeVisible).ClearContents
sh1.AutoFilterMode = False
End Sub

 

[JLGWhiz]

You would have to use event code to do that. Put this in the worksheet code module for the sheet where you have the validation lists.

Private Sub worksheet_Change(ByVal Target As Range)
If Target.Cells.Count <> 1 Then Exit Sub
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If LCase(Target.Value) = "bingo" Then
            Range("A" & Target.Row).Resize(, 7).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    End If
End Sub

To access the sheet code module, right click the sheet name tab, then click 'View Code' in the pop up menu. Copy and paste the code into the code module, then save the workbook as a macro enabled workbook to preserve the code. Close the editor and the code will execute when changes occur in column H.. This code assumes that headers will already be on row four of sheet 2.

 

[helpexcel]

Thanks!! It wasn't working, so I changed it to call the marco i knew worked. Thanks again for your help!!

Private Sub worksheet_Change(ByVal Target As Range)


If Target.Cells.Count <> 1 Then Exit Sub
If Not Intersect(Target, Range("H3:H15")) Is Nothing Then
Call bingo
End If
End Sub

 

[helpexcel]

I just realized that it errors out if something other than "bingo" is put in Column H. How do i change it to only run when "bingo" appears?

 

[helpexcel]

This is it, works great. Thanks!!

Private Sub worksheet_Change(ByVal Target As Range)


If Target.Cells.Count <> 1 Then Exit Sub
If Not Intersect(Target, Range("H3:H15")) Is Nothing Then
Select Case Target.Value
Case "bingo"
Call bingo
End Select

End If


End Sub

 

[JLGWhiz]

Glad you got it worked out and thanks for the feedback,
regards, JLG