Problem with Code

[Trevasaurus]

I have this code for comparing two columns, finding repeated entries, and deleting the row where the entry is repeated. I've tested it on a small data base (<50 entries) and it works. However, when I apply it to a larger database (>300), I'm getting an error: "Subscript Out of Range"

Sub find_copy01()
Dim c2 As Range, c As Range
With Sheets("Sheet2")
LR = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Each c2 In .Range("A1:A" & LR)
Set c = Sheets("Sheet1").Columns(1).Find(c2, , xlValues, xlWhole)
If Not c Is Nothing Then
c.EntireRow.Interior.Color = vbRed
c2.EntireRow.Delete
End If
Next c2
End With
End Sub

Can anyone tell me what is wrong?

 

[Jerry Sullivan]

Hi and Welcome to the Board,

Here's an alternative approach you could try...

Sub DeleteRowsWithMatch()
  Dim lLastRow As Long, lUnusedColumn As Long
  With Sheets("Sheet1")
    lUnusedColumn = .Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
    lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    With .Cells(1, lUnusedColumn).Resize(lLastRow)
        .FormulaR1C1 = "=iferror(MATCH(RC1,Sheet2!C1,0),"""")"
        .Value = .Value
        On Error Resume Next
        .SpecialCells(xlConstants).EntireRow.Delete
        On Error GoTo 0
    End With
  End With
End Sub

I haven't tested your code, but I suspect that the cause of the "Subscript Out of Range" was that you were trying to delete rows one at a time from the top down. When doing that you need to go from the bottom to the top or else the index numbers of rows to be deleted gets changed during the process.

Deleting rows is relatively slow, so you are better off doing one step of deleting many rows as shown in this code instead of deleting rows separately.

 

[Trevasaurus]

Hey.

I got my error to go away but now I'm having another problem, the macro only deletes some of the repeated cell rows. I'll try going from bottom up.

I tested your code and it just deletes the whole data base. It does it a lot faster than mine would though.

Thanks for the help.

Trev-

 

[Jerry Sullivan]

I tested your code and it just deletes the whole data base.

Trev, Are you saying that when you tried my code it deleted all rows, even the ones that didn't have matches in the other sheet?

If you are using xl2007 or earlier and you have more than 16,000 rows of data, you might be hitting the SpecialsCells limitation of handling 8192 areas.
The .SpecialCells(xlCellTypeBlanks) VBA function does not work as expected in Excel

Ron de Bruin's site has some work arounds and links to other suggestions.
SpecialCells limit problem

Please let me know if that isn't the cause and we track down the problem.

 

[Trevasaurus]

Hey Jerry.

Yes. The code deleted everything.
I'm using Excel 2003 but I'm testing the code on a small data set with less than 30 rows. Even with my actual data sets, the rows shouldn't exceed 16000 though.

I wish I could attach a file for example but I'll try to type one out here. I'm trying to Match the ID column from sheet 2to the ID column in sheet1 and delete those rows in sheet1 where the ID = any ID's in sheet2.

(sheet1)
A B C D(ID)
name type area GC
name type area MGC
name type area IS
(/sheet1)

(sheet2)
A
GC
IS
ABC
CDE
(/sheet2)

 

[Jerry Sullivan]

Oh - your original code was looking for the ID in Column "A"

Try changing this line.

 .FormulaR1C1 = "=iferror(MATCH([B][COLOR="#0000CD"]RC4[/COLOR][/B],Sheet2!C1,0),"""")"   'RC4 is Column "D"

I would have expected the previous code to not delete any rows if it was looking for matches in the wrong column.

If the fix above doesn't work. Try putting a breakpoint in your code before the .Value=.Value line is run so you can see if the formula is correctly marking rows to delete with Numbers and rows to keep with Blanks.

 

[Jerry Sullivan]

You'll also need to adjust this line...

    lLastRow = .Cells(.Rows.Count, "[B][COLOR="#0000CD"]D[/COLOR][/B]").End(xlUp).Row

 

[Trevasaurus]

Hey Jerry.
I made those corrections but its still deleting all of the data. I also added the break before the .value line but I didn't see any rows getting marked.
I've had some success with the below code, but the problem I'm having with this is that it only deletes one matching ID pair and leaves all of the other duplicate ID's untouched.

Sub find_copy11()
Dim c2 As Range, c As Range
With Sheets("Sheet2")
 LR = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 For Each c2 In .Range("A1:A" & LR)
   Set c = Sheets("Sheet1").Columns(4).Find(c2, , xlValues, xlWhole)
    If Not c Is Nothing Then
    c.EntireRow.Delete
    End If
   Next c2
 End With
End Sub

 

[Jerry Sullivan]

Trev,

The code that I suggested is working correctly in my mockup of the data you posted.

Do you have anything special going on in your sheet like merged cells?

The reason your code isn't working is that it is still going Top to Bottom. The For Each Cell in Range technique will step through the cells in their index order in the Range reference. That will be Top to Bottom unless you have explicitly selected the order of a multi-cell reference.

If merged cells isn't the issue, you can send me your workbook by email. Let me know and I'll send you a PM with the my address.

 

[Trevasaurus]

Hey Jerry.

There's nothing special in my database. No merged cells. I can email you an attached copy of the data base I'm working on.