CODEWITHSUNDEEP
vbaexcelfor-loopmatch
Stupid_Intern
Stupid_Intern

Reputation: 3450

Excel stops responding after a while -for loop vba

When I run the following code excel stops responding after a while(5-6 secs)

What it does:

Gets Value in e1 checks if present on either of the two sheets wo or wn if yes then move the row from which e1 got it's value to another sheet wr if not found then do nothing

Option Explicit

Sub RemoveEmail()
Dim wi, wn, wo, wr As Worksheet
Dim e1
Dim FinalRowI, FinalRowN, FinalRowO, FinalRow
Dim i, j

Set wi = Sheet2
Set wn = Sheet3
Set wo = Sheet4
Set wr = Sheet5

FinalRowI = wi.Range("B1048576").End(xlUp).Row
FinalRowN = wn.Range("C1048576").End(xlUp).Row
FinalRowO = wo.Range("C1048576").End(xlUp).Row

FinalRow = WorksheetFunction.Max(FinalRowN, FinalRowO)

For i = 2 To FinalRowI
e1 = Trim(wi.Range("B" & i).Text)
    For j = 2 To FinalRow
        If Trim(wn.Range("C" & j).Text) = e1 Or Trim(wo.Range("C" & j).Text) = e1 Then
         wi.Cells(i, "A").EntireRow.Cut Destination:=wr.Range("A" & wr.Rows.Count).End(xlUp).Offset(1)
        Else: End If
        Application.CutCopyMode = False
    Next j
Next i

End Sub

Upvotes: 1

Views: 251

Answers (1)

user4039065
user4039065

Reputation:

You should not be checking the Range.Text property unless there is some cell formatting that would change the result. For text (email...?) the Range.Value2 property is the most efficient. Also, once you've located a match and xlCut the row out of the original, there is no point in continuing through the loop. Get on with the next value.

For i = 2 To FinalRowI
    e1 = Trim(LCase(wi.Range("B" & i).Value2))  'unless you have formatting you want to check, .Text is inefficient
    For j = 2 To FinalRow
        If Trim(lcased(wn.Range("C" & j).Value2)) = e1 Or Trim(LCase(wo.Range("C" & j).Value2)) = e1 Then
            wi.Cells(i, "A").EntireRow.Cut Destination:=wr.Range("A" & wr.Rows.Count).End(xlUp).Offset(1)
            Exit For  'you've cut out the row. no need to continue
        End If
        'Application.CutCopyMode = False  'no need for this on a cut
    Next j
Next i

See Should I turn .CutCopyMode back on before exiting my sub procedure? for more information on why Application.CutCopyMode = False is unnecessary.

Suggest switching to this method using the native worksheet COUNTIF function.

For i = 2 To FinalRowI
    e1 = Trim(wi.Range("B" & i).Value2)
    If CBool(Application.CountIf(wn.Columns(3), e1)) Or CBool(Application.CountIf(wr.Columns(1), e1)) Then
        wi.Cells(i, "A").EntireRow.Cut _
          Destination:=wr.Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
Next i

The MATCH function is even more efficient but you would have to test for IsError twice (once for each worksheet.

Upvotes: 1

Related Questions