Scrub a Mailing List

Suppose you had two mailing lists - one with both good and bad addresses and one with rejected or bad addresses. You can very quickly delete the bad addresses from the first mailing list (spammers take note - my address should be deleted from all lists).

This uses an loopless Evaluate(Replace( )) technique first brought to my attention by Dana's quite fast. Change the Book, sheet and range names as necessary. The COLNUM constant should be a number of a column to the right of your data. And of course, back up your data before running:

    Public Sub ScrubList()
        Const COLNUM As Integer = 256
        Dim listRng As Range
        Dim badRng As Range
        Dim formStr As String
        With Workbooks("ListBk.xls").Sheets("Sheet1")
            Set listRng = .Range("A1:A" & .Range("A" & _
        End With
        With Workbooks("Badbk.xls").Sheets("Sheet1")
            Set badRng = .Range("A1:A" & .Range("A" & _
        End With
        With badRng
            formStr = "=IF(COUNTIF([" & .Parent.Parent.Name & _
                "]" & .Parent.Name & "!" & .Address & ", %),"""",1)"
        End With
        With listRng
            .Offset(0, COLNUM).Formula = Evaluate(Replace( _
                    formStr, "%", .Address))
            On Error Resume Next 'In case no rows to be deleted
            .Offset(0, COLNUM).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
            .Offset(0, COLNUM).EntireColumn.Delete
        End With
    End Sub

Note: Replace() is only available for VBA versions greater than 5 (i.e., XL020/02/03). For XL97/98/01/v.X, you'll need to roll your own (you can use Microsoft's routines), or use Application.Substitute() instead.

Valid XHTML 1.1!Valid CSS!Made on a Mac