Macro selecting search criteria from a table

Hi all,

I have this macro below which might not be the fastest but seems to work pretty well. I need some help on having it pick up value criteria from a table rather than manually inputting it as I have currently 20 that I need to search for and delete and might have some more so ideally something where it can pick up a larger list and then search for true values within the list that would be ideal. Currently I have the list of values I want to search for to delete rows that include that value, they are on K16 to K35 but I might expand the list so if its possible to do up to for e.g. K40 and search for true values in the list that would be ideal.

I also have the list on a different sheet caller Drivers and the dataset I want to remove values from is called Import Data, I want to be able to run the macro from the Drivers page from a button so I also need a line adding to do the search on the Import Data page rather than the active sheet.

Can someone thing of an easy solution for this either adding in a couple of lines or if its easier then doing the macro a different way?

Thanks in advance.

Sub RemoveCode()

Dim x As Long, lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For x = lastrow To 1 Step -1
If Cells(x, 6).Value = "XXXX" Then
Rows(x).Delete
End If
Next x

End Sub

Quote from Carim

Hi,

You could test the following macro ... on a copy of your actual workbook ...

Code

Sub RemoveCodes()


Dim lastrow As Long, lastrowK As Long, c As Range, rngK As Range
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastrowK = Cells(Rows.Count, 11).End(xlUp).Row
Set rngK = Range("K35:K" & lastrowK)


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In rngK
ActiveSheet.AutoFilterMode = False
' ''''''''''MAKE SURE TO ADJUST THE RANGE TO YOUR ACTUAL SITUATION '''''''''''''''''''''''''''
With ActiveSheet.Range("A1:M" & lastrow)
.AutoFilter Field:=6, Criteria1:="=" & c.Value
.Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Next c
' Back to Normal
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Display More

Hope this will help

Display More

Hi,

Thank you, I am getting a Runtime 1004 error on this row : .Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Any idea on what it could be?

Quote from Carim

Hi,

Thanks for attaching a sample file with your next message ...

Probably one of the codes in your K range ... does not appear at all ... :wink:

I took a look through and realised where its going wrong. The list of values I want to filter against is on a sheet called Drivers and the data I want to delete rows from is on a sheet called Import Data on the same file.

Is there a way to have it switch between the sheets? I want to run the macro from the Driver sheet with the criteria values on it.

Quote from Carim

Hi again,

Glad to hear we are heading in the right direction ...

Code

Sub RemoveCodes()
' Sheets("Drivers")
' Sheets("Import Data")


Dim lastrow As Long, lastrowK As Long, c As Range, rngK As Range
lastrow = Sheets("Import Data").Cells(Rows.Count, 1).End(xlUp).Row
lastrowK = Sheets("Drivers").Cells(Rows.Count, 11).End(xlUp).Row
Set rngK = Sheets("Drivers").Range("K35:K" & lastrowK)


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In rngK
Sheets("Import Data").AutoFilterMode = False
' ''''''''''MAKE SURE TO ADJUST THE RANGE TO YOUR ACTUAL SITUATION '''''''''''''''''''''''''''
With Sheets("Import Data").Range("A1:M" & lastrow)
.AutoFilter Field:=6, Criteria1:="=" & c.Value
.Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Next c
' Back to Normal
Sheets("Import Data").AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Display More

Hope this corresponds to your actual situation

Display More

That worked an absolute treat, thank you. Is there a way to add some sort of error correction so if one value doesn't exist then it would skip it rather than crash the macro?

Also I know there is a very simple way to add a pop up message at the end of the macro however I don't remember from years ago when I learned. Could you drop a line at the end of the macro to add a pop up box with a message saying "Complete"?

Quote from Carim

Glad we are progressing ...

To take into account your two latest requests ...

Code

Sub RemoveAllCodes()
Dim lastrow As Long, lastrowK As Long, c As Range, rngK As Range
Dim res As Variant
lastrow = Sheets("Import Data").Cells(Rows.Count, 1).End(xlUp).row
lastrowK = Sheets("Drivers").Cells(Rows.Count, 11).End(xlUp).row
Set rngK = Sheets("Drivers").Range("K35:K" & lastrowK)


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In rngK
res = Application.Match(c.Value, Sheets("Import Data").Range("F1:F" & lastrow), 0)
If Not IsError(res) Then
Sheets("Import Data").AutoFilterMode = False
' ''''''''''MAKE SURE TO ADJUST THE RANGE TO YOUR ACTUAL SITUATION '''''''''''''''''''''''''''
With Sheets("Import Data").Range("A1:M" & lastrow)
.AutoFilter Field:=6, Criteria1:="=" & c.Value
.Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End If
Next c
' Back to Normal
Sheets("Import Data").AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox " All Codes have been Removed ..."
End Sub

Display More

Hope this will be fine ...

Display More

Hi,

That is absolutely perfect, thank you.