Delete Rows Based on Cell Value from Another Sheet with Macro

[rangequestion]

Hi,

Hopefully this will be n easy question. In my active sheet I have an identifier in cell D5. Based on that ID I want to delete all rows in a sheet called "All Remotely Booked Txn Table" that do not have that ID in column B.

For example, if my ID is 982 I want the macro to delete all rows that do not have 982 in column B of tab called "All Remotely Booked Txn Table".

Thanks!

 

[mumps]

I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[rangequestion]

https://app.box.com/s/5l19fih5ubop7d4b1nktihrnb9vsanq7

Thanks, file is located above:

 

[mumps]

Try this macro. You will be prompted to enter an ID to filter the data. The macro then checks to make sure that the entered ID actually exists in column B. If it doesn't exist, the macro stops executing. This is necessary because if the entered Id does not exist, all the data in the "All Remotely Booked Txn Table" sheet will be deleted.

Sub DeleteRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, sDate As Date, eDate As Date, ID As String
    sDate = Sheets("Static Data").Range("D12").Value
    eDate = Sheets("Static Data").Range("D13").Value
    LastRow = Sheets("All Remotely Booked Txn Table").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ID = InputBox("Please enter the ID to filter.")
    If ID = "" Then
        MsgBox ("No ID was entered.")
        Application.ScreenUpdating = False
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Sheets("All Remotely Booked Txn Table").Range("B:B"), ID) = 0 Then
        MsgBox ("The Id entered does not exist.")
        Application.ScreenUpdating = False
        Exit Sub
    End If
    Sheets("All Remotely Booked Txn Table").ListObjects("Table_Remotely_Booked_Transactions.accdb").Range.AutoFilter Field:=11, Criteria1:="<" & sDate, Operator:=xlOr, Criteria2:=">" & eDate
    Application.DisplayAlerts = False
    Sheets("All Remotely Booked Txn Table").Range("Table_Remotely_Booked_Transactions.accdb").SpecialCells(xlCellTypeVisible).Delete
    If Sheets("All Remotely Booked Txn Table").FilterMode Then Sheets("All Remotely Booked Txn Table").ShowAllData
    Sheets("All Remotely Booked Txn Table").ListObjects("Table_Remotely_Booked_Transactions.accdb").Range.AutoFilter Field:=2, Criteria1:="<>" & ID
    Sheets("All Remotely Booked Txn Table").Range("Table_Remotely_Booked_Transactions.accdb").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    If Sheets("All Remotely Booked Txn Table").FilterMode Then Sheets("All Remotely Booked Txn Table").ShowAllData
    Application.ScreenUpdating = True
End Sub

 

[rangequestion]

Thanks for working on this on a Saturday. The Macro seems to stop at this point:

Sheets ("All Remotely Booked Txn Table") .Range("Table_Remotely Booked_Transaction.accdb") .SpecialCells(xlCellTypeVisible) .Delete

 

[mumps]

There are 2 lines of code like that one. Does it stop at the first or second line? What error do you get when you click "Debug"? Are you using the macro on the file you posted or on a different file? If on a different file, perhaps you could upload a copy of the file that is not working.

 

[rangequestion]

Now I'm getting the error on the 2nd to last line of code that begins: "If Sheets ("All....)".

It's a Run-time error '1004'. ShowAllData method of Worksheet class failed"

 

[rangequestion]

It looks like the filters are working properly but when I go to the sheet with the raw data the rows are hidden and the ID needs to be selected in the filter for them to show up.

Meaning the data is filtered, perhaps that's why the error is occurring?

 

[rangequestion]

Finally figured out what's going on here. My data set has over 200k rows and it looks like that's what is causing the issue....Any way around this? Seems like initially the macro kept looping into the logic and never stopped. After deleting 99% of the rows it works perfectly, but really doesnt solve the original problem.

 

[mumps]

This should take care of the hidden rows:

Sub DeleteRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, sDate As Date, eDate As Date, ID As String
    sDate = Sheets("Static Data").Range("D12").Value
    eDate = Sheets("Static Data").Range("D13").Value
    LastRow = Sheets("All Remotely Booked Txn Table").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ID = InputBox("Please enter the ID to filter.")
    If ID = "" Then
        MsgBox ("No ID was entered.")
        Application.ScreenUpdating = False
        Exit Sub
    End If
    If WorksheetFunction.CountIf(Sheets("All Remotely Booked Txn Table").Range("B:B"), ID) = 0 Then
        MsgBox ("The Id entered does not exist.")
        Application.ScreenUpdating = False
        Exit Sub
    End If
    Sheets("All Remotely Booked Txn Table").ListObjects("Table_Remotely_Booked_Transactions.accdb").Range.AutoFilter Field:=11, Criteria1:="<" & sDate, Operator:=xlOr, Criteria2:=">" & eDate
    Application.DisplayAlerts = False
    Sheets("All Remotely Booked Txn Table").Range("Table_Remotely_Booked_Transactions.accdb").SpecialCells(xlCellTypeVisible).Delete
    Sheets("All Remotely Booked Txn Table").Range("B1").AutoFilter
    Sheets("All Remotely Booked Txn Table").ListObjects("Table_Remotely_Booked_Transactions.accdb").Range.AutoFilter Field:=2, Criteria1:="<>" & ID
    Sheets("All Remotely Booked Txn Table").Range("Table_Remotely_Booked_Transactions.accdb").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    Sheets("All Remotely Booked Txn Table").Range("B1").AutoFilter
    Application.ScreenUpdating = True
End Sub

What do you mean by:

really doesnt solve the original problem.