Dumb Delete Question

[rosalie.macdonald]

Hi Out There,

It's been a very long time since I've had to do any programming and I
never had lot of experience doing anything in Excel as you can see I'm
sure. I need the help of some gurus.

OK I have two workbooks of exported data that I have to clean up. The
first is accounts and the second is contacts. Each account has multiple
rows of contacts in the contact workbook and the Contacts WB contains
"foreign key" column account ID. Many of the accounts in the account
workbook are marked for deletion by a Y/N column and any account that
has to be deleted is assigned an "N". The idea is that before we delete
the accounts I want to search for contacts associated with the
accountID in the Contacts workbook and delete them first. We have an
awful lot of data so automating this process would be of great help.

I created a range in the Accounts WB called "RangeDelete" which selects
the Y/N column. I want to loop through each of these values and for
every "N" grab the Account ID and use it to search the Contacts WB and
then delete that contact row. I also created a range in the Contacts WB
called "AccountIDRange" which selects the account ID column in the
contacts WB.

The code below works fine if there is only one contact row to delete,
but if there are two contacts the For Each loop count gets screwed up.
When the row is deleted, the rows all move up one but the counter is on
the next row. For example I have Contacts on row 3 and row 4 with an
account ID to delete. I delete contact 3 but now row 4 becomes row 3 so
loop counter has passed it by.

Help!! And thanks muchly

Here is the code I have:

'Account workbook
ThisWorkbook.Activate

'loop through all the account ID's to be deleted ie value = "N"
For Each myCell In Range("RangeDelete")

If myCell.Value = "N" Then

AccountID = Trim$(Cells(myCell.Row, 1).Value)
ContactWB.Activate

'loop through all the contacts with corresponding account
IDs and delete
For Each myCell2 In Range("AccountIDRange")

If StrComp(Trim$(myCell2.Value), AccountID,
vbBinaryCompare) = 0 Then

ContactWB.Sheets("contacts").Rows(myCell2.Row).Delete
End If
Next 'next Contact Row

'have to reactivate account workbook
ThisWorkbook.Activate

End If

Next 'next Account ID

 

[Fred]

Rosalie try

Dim delRng as Range
'Account workbook
ThisWorkbook.Activate

'loop through all the account ID's to be deleted ie value = "N"
For Each myCell In Range("RangeDelete")
If myCell.Value = "N" Then
AccountID = Trim$(Cells(myCell.Row, 1).Value)
ContactWB.Activate
'loop through all the contacts with corresponding account IDs and
delete
For Each myCell2 In Range("AccountIDRange")
If StrComp(Trim$(myCell2.Value), AccountID, > vbBinaryCompare) =
0 Then
If delRng is Nothing Then
Set delRng = myCell2
Else
Set delRng = Union(delRng, myCell2)
End If
End If
Next 'next Contact Row
If Not delRng Is Nothing then
delRng.EntireRow.Delete
Set delRng = Nothing
End If
'have to reactivate account workbook
ThisWorkbook.Activate
End If
Next 'next Account ID


Of course this would work a lot faster without activating alternative
workbooks all the time. To that you can qualify the appropriate cell
references with either ThisWorkbook or ContactWB. E.g.

Dim delRng as Range

'loop through all the account ID's to be deleted ie value = "N"
For Each myCell In ThisWorkbook.Range("RangeDelete")
If myCell.Value = "N" Then
AccountID = Trim$(ThisWorkbook.Cells(myCell.Row, 1).Value)

Set delRng = Nothing
'loop through all the contacts with corresponding account IDs and
delete
For Each myCell2 In ContactWB.Range("AccountIDRange")
If StrComp(Trim$(myCell2.Value), AccountID, vbBinaryCompare) = 0
Then
If delRng is Nothing Then
Set delRng = myCell2
Else
Set delRng = Union(delRng, myCell2)
End If
End If
Next 'next Contact Row
If Not delRng Is Nothing then
delRng.EntireRow.Delete
End If
End If
Next 'next Account ID

If this is still to slow you may want to look at using the worksheet
function Match rather than looping through all of the rows.

 

[JMB]

instead of deleting one row at a time, try setting up a range variable
representing the rows you want to delete and delete this range after your for
loop has terminated.

Or you can set up a for loop and loop through the range from the bottom up.

Dim RangeToDelete as range
....
....
....

For Each myCell2 In Range("AccountIDRange")
If StrComp(Trim$(myCell2.Value), AccountID,
vbBinaryCompare) = 0 Then
If RangeToDelete Is Nothing Then
Set RangeToDelete = mycell2
else: Set RangeToDelete = Union(RangeToDelete, mycell2)
end if
End If
Next 'next Contact Row
RangeToDelete.EntireRow.Delete

....
....
Next 'Account ID

 

[JMB]

Make sure you back up your workbook until you're satisfied you got the
results you want.

 

[JMB]

Sorry, was a bit too hasty

instead of

RangeToDelete.EntireRow.Delete

use

If Not RangeToDelete Is Nothing Then
RangeToDelete.EntireRow.Delete
Set RangeToDelete = Nothing
End If

 

[Tushar Mehta]

While the approach you are using will eventually work, it doesn't
leverage the real power of XL and the XL object model. Here's how to
get XL to do the 'heavy lifting' to delete the contacts.

Add a new column to the contacts table that uses the Account ID and the
VLOOKUP to add the Y/N field that is already in the accounts table.
Now, create an autofilter in the contacts table. Set the new column to
'n' Now select all visible rows and delete. If you want to automate
this first turn on the macro recorder and then do the above. XL gives
you pretty decent code that can then be cleaned up.

You will have to adjust the code below to fit the size and columns of
your own tables. I assumed the Accounts table has only 2 columns,
AccountID and DeleteFlag. The Contacts table (in the contacts
worksheet) has 3 columns, the 2nd of which is the AccountID.

Sub Macro2()
With Worksheets("contacts")
.Range("D1").FormulaR1C1 = "Delete"
.Range("D2").FormulaR1C1 = "=VLOOKUP(RC[-2],Sheet1!C1:C2,2,FALSE)"
.Range("D2").AutoFill _
Destination:=.Range(.Range("a2"), _
.Range("a2").End(xlDown)).Offset(0, 3)
With .Columns("A")
.AutoFilter
.AutoFilter Field:=4, Criteria1:="n"
Intersect(.Rows("2:" & .Rows.Count), _
.SpecialCells(xlCellTypeVisible)).EntireRow.Delete
.AutoFilter
End With
.Columns("D").Delete
End With
End Sub


--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions