Solved: Delete specific rows too slow

Hi there Everyone! I have a macro which deletes rows based on a given criteria. The main point of the macro is that the users should see only data relevant to them. So what I figured out is: that when the user opens the file (and gives the password) based on the given login name and correct password all the rows not related to the user will be deleted.

The macro verifies if in column "F" or "K" is the given value, and if not then deletes the whole row. The macro is working perfectly... but as there are more then 40.000 rows it is very slow, painfully slow. It takes around 20-30 minutes to run. As I am very very new with VBA I am sure that there is a better/faster solution. Please help me if you can! See below my code:

Code:

---

Sub kozepmagyar()

Worksheets(1).Activate
Dim i As Long
i = 1
Do While Cells(i, "a").Value <> ""
If Cells(i, "f").Value <> "Közép-Magyarország" Or Cells(i, "k").Value <> "Közép-Magyarország" Then
 Rows(i).EntireRow.Delete
End If

i = i + 1

Loop

End Sub

---

Please help if you can!
Thank you in advance!

[vba]

Sub kozepmagyar()
Dim rng As Range
Dim LastRow As Long
Dim LastRow1 As Long
Dim i As Long

With Worksheets(1)

LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
LastRow1 = .Cells(.Rows.Count, "K").End(xlUp).Row
If LastRow1 > LastRow Then LastRow = LastRow1

.Rows(1).Insert
.Columns("L").Insert
.Range("L1").Value = "Temp"
.Range("L2").Resize(LastRow).Formula = "=OR(F2<>""Közép-Magyarország"",K2<>""Közép-Magyarország"")"
Set rng = .Range("F1").Resize(LastRow + 1, 7)
rng.AutoFilter field:=7, Criteria1:="=TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
rng.EntireRow.Delete
End With

End Sub
[/vba]

Clever Bob, i like that a lot :)

Hello XLD! Thank you very much for your reply. Unfortunately the provided macro it is not working. I found the following problems:

1. the row "=OR(F2<>""Közép-Magyarország"",K2<>""Közép-Magyarország"")" sets the temp column values only till row 30723

2. the value of the "temp" column is always true. however what I need is to delete all those rows in which Közép-Magyarország is not present in column "F" or column "K". So if Közép-Magyarország is the value in any of the K and F columns than that row should not be deleted. I think in your case it does not delete the row if in both K and F columns is present Közép-Magyarország.

Okay, cghange

[vba]

.Range("L2").Resize(LastRow).Formula = "=OR(F2<>""Közép-Magyarország"",K2<>""Közép-Magyarország"")"
[/vba]

to

[vba]

.Range("L2").Resize(LastRow).Formula = "=AND(F2<>""Közép-Magyarország"",K2<>""Közép-Magyarország"")"
[/vba]

Hello XLD! Thank you sooo much! :) Now it is working. The only problem remaining is that in columns F and K there are many blank cells as well. Your solution will fill the temp column only till the last "Közép-Magyarország" value in F or K column. But there are many blank cells left under these values. These rows are not deleted, however they should be deleted.
Maybe that would help that column "A" is filled in cells with values. I hope you understand my problem! Thank you again for your help!

I guessed that might be the case, should have asked last time.

Try this mod

[vba]

Sub kozepmagyar()
Dim rng As Range
Dim LastRow As Long
Dim i As Long

With Worksheets(1)

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

.Rows(1).Insert
.Columns("L").Insert
.Range("L1").Value = "Temp"
.Range("L2").Resize(LastRow).Formula = "=AND(F2<>""Közép-Magyarország"",K2<>""Közép-Magyarország"")"
Set rng = .Range("F1").Resize(LastRow + 1, 7)
rng.AutoFilter field:=7, Criteria1:="=TRUE"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error Goto 0
rng.EntireRow.Delete
End With

End Sub
[/vba]

Yep! Working like charm! Thank you very much for your precious help! Problem solved! Thank you!