code needs to be faster, XL dies

[thexfactor44]

you're all probably tired of hearing about this:
This code has been given to me to search sheet 2's column A for any value in sheet 1's Column A and delete the entire row in Sheet 2 if found. the issue is that it consumes way too much memory and crashes xl(2k). is there a way to speed it up or make it use less mem? thanks!
(FYI: Sheet 1's column A, or the value to search for is 5K deep, Sheet 2 is the sheet to search in and is 25K deep)


Sub DeleteRedundants()

Dim i As Integer, j As Integer

'Loop through first sheet
For i = 1 To 60000

'Exit if blank cell found
If Sheets("Sheet1").Cells(i, 1).Value = "" Then Exit For

'Loop through second sheet
For j = 1 To 60000
'Exit if blank cell found
If Sheets("Sheet2").Cells(j, 1).Value = "" Then Exit For
'If duplicate found, delete the row and exit
If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
Sheets("Sheet2").Cells(j, 1).EntireRow.Delete
Exit For
End If

Next

Next

End Sub

[Jack in the UK]

I can’t provide the answer with new codes, but I can advise why the script runs slow

You are pushing Excel and beautiful as she is that shopping heavy and so the loop means she carry’s extra beers for us boys. Thus a little later getting home. OK a childish explanation but you understand

The loop is slow and always will be.

I use FIND and act on that find IE do them all at the same time.

This mean fast codes, just a different way to work, remember slow is only if you MUST be super fast, few seconds matters little.

[Jay Petrulis]

Try the following,

Sub test()
Dim Rng1 As String, lastrow As Long

Application.ScreenUpdating = False

With Sheets("Sheet1")
Rng1 = Intersect(.UsedRange, .Range("A:A")).Address(True, True, xlR1C1)
End With

With Sheets("Sheet2")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 2), .Cells(lastrow, 2)) = "=MATCH(RC[-1],Sheet1!" & Rng1 & ",0)"
.Rows(1).Insert
    With .Cells(1, 2)
        .Value = "Temp"
        .AutoFilter Field:=2, Criteria1:="<>#N/A"
    End With
.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Columns(2).Clear
End With

End Sub

This assumes that there is nothing in column B in sheet 2. You would have to adjust a few things above to account for that (easily done, but please report back any problems first).

Bye,
Jay

EDIT: The rows have to match as well? If that is the case, try...

Sub test2()
Dim lastrow As Long

With Sheets("Sheet2")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 2), .Cells(lastrow, 2)) = "=IF(RC[-1]=Sheet1!RC[-1],1,0)"
.Range(.Cells(1, 2), .Cells(lastrow, 2)).Copy
.Range(.Cells(1, 2), .Cells(lastrow, 2)).PasteSpecial (xlValues)
.Rows(1).Insert
    With .Cells(1, 2)
        .Value = "Temp"
        .AutoFilter Field:=2, Criteria1:="<>1"
    End With
.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Columns(2).Clear
End With
MsgBox "Done!"

End Sub

[ This Message was edited by: Jay Petrulis on 2002-05-24 15:09 ]

[thexfactor44]

while the above code works as well, quite nicely when I my columns are approx. 100 deep, it freezes up the program when i try to run it searching within a coulmn 5000 sells deep (sheet 1) into a column 25000 deep (sheet 2). any suggetions?

[Jay Petrulis]

I tried this with a full column of data (65,536 points) on Sheet1 and 25,000 points on Sheet2.

Sub test()
Dim Rng1 As String, lastrow As Long

Application.ScreenUpdating = False

With Sheets("Sheet1")
Rng1 = Intersect(.UsedRange, .Range("A:A")).Address(True, True, xlR1C1)
End With

With Sheets("Sheet2")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

Application.Calculation = xlCalculationManual
.Range(.Cells(1, 2), .Cells(lastrow, 2)) = "=MATCH(RC[-1],Sheet1!" & Rng1 & ",0)"
.Range(.Cells(1, 2), .Cells(lastrow, 2)).Copy
.Range(.Cells(1, 2), .Cells(lastrow, 2)).PasteSpecial (xlValues)
Application.Calculation = xlCalculationAutomatic

.Rows(1).Insert
    With .Cells(1, 2)
        .Value = "Temp"
        .AutoFilter Field:=2, Criteria1:="<>#N/A"
    End With
.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Columns(2).Clear
End With

End Sub

There are two bottleneck lines.

1. The line that loads the =MATCH function to the worksheet.

2. The line that deletes the rows.

I turned off the autocalc for the first one to speed it up as much as possible.

Will try to load it all into an array, too.

Bye,
Jay

EDIT: It shouldn't bomb your computer. Just give it time to run (depending on the speed of your machine, possibly even 5-6 minutes) and you will get what you need. I just did 45K on sheet1 and 9K on sheet2 in under 2 minutes.

The original For-Next loop shouldn't bomb your computer, either, although it will be slow as well.

[ This Message was edited by: Jay Petrulis on 2002-05-24 15:56 ]

[robfritts]

Just an observation here... But I've been working with conditionally deleting rows and found two things that sped it up significantly for me...

Turn off screen updates (autoupdate something or other) and instead of .DeleteRow, I just used .ClearContents and it ran many many times faster although I'm not entirely sure why.

[Jack in the UK]

Clear contents will out strip delete simple as there is not cells movement simple as that, delete row 2 and 65536 cells less 2 gog up one and an extra slip in the bottom making 65536, thus all even

Clear contents save the delete / move / new row.

Same with columns but these are ever slower, chink …. Chink regardless or power VBA codes. Just that way.

The reason is excl need to address and re address that sheets data and check it correct each time the standard square (65536x256 falls out of that square and will make sure its replaced.

EG if you delete row so that they are gone not seen or usable EXCEL still carries then, and has them there just out of reach – excel lives in a box, I guess is the simplest way to explain this

Turn of screen update will spin code faster un less you have doc changes and doc saves on the fly where S U D must be on.. is on needs..