PDA

View Full Version : delete rows based upon external list



jhetrick62
07-20-2007, 08:28 AM
I have searched the posts and see many howtos on deleted rows based upon small lists that are embedded into the macros, but none on external criteria such as a static, external workbook.

My situation is that we get 12 spreadsheets ea. month which are imported csv data with anywhere from 2000 - 8000 lines of AR receiveables data entries. We need to be able to maintain a list of plans that we want to delete from the list as they are tracked by an outside vendor.

Our AR spreadsheets are in the format:

Plan Current 30-60 60-90 +90
ABC 345.09
ABC 234.54
ABC 125.00
BFG 54.56
CGW 10.56
DBT 199.03

ect.....

I need to maintain a separate spreadsheet of all data that needs to be deleted ea. month and then run a VBA macro to delete every row that has a match in column A to that external list. There will be many duplicate matches as sometimes there are hundreds of entries for 1 particular plan code.

Separate spreadsheet will just be 1 column of plan names to delete such as

Plan
BFG
DBT
ect.....

So in the above example ALL entries in the current AR spreadsheet that have "BFG" or "DBT" in column "A" would have that entire row deleted from the database.

Any help would be appreciated.

Thanks,
Jeff

Bob Phillips
07-20-2007, 09:04 AM
Here is a routine to do it



Sub DeletionManager()
Const FREE_COLUMN As String = "J" '<=== change to suit
Const MATCH_WB As String = "List.xls" '<=== change to suit
Const MATCH_SS As String = "Deletions" '<=== change to suit
Dim iLastRow As Long
Dim i As Long
Dim rng As Range

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(FREE_COLUMN & "1").Resize(iLastRow) = "=ISNUMBER(MATCH(RC1,'[" & MATCH_WB & "]" & MATCH_SS & "'!C1,0))"
.Rows(1).Insert
.Range(FREE_COLUMN & "1").Value = "Temp"
Set rng = .Range(FREE_COLUMN & "1").Resize(iLastRow + 1)
rng.AutoFilter field:=1, Criteria1:="TRUE"
rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub

jhetrick62
07-20-2007, 01:52 PM
xld,

Thank you very much and this did the trick!

Jeff