1

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
Stupid_Intern
  • 3,382
  • 8
  • 37
  • 74
  • If you are just checking for the *existence* of a value from **wi** in either **wn** or **wo** there are several more efficient methods of looking for it rather than cycling through each row. MATCH or even COUNTIF come immediately to mind. –  Dec 13 '15 at 17:16
  • @Jeeped but that's not the only purpose I want to move the matched data from `wi` to `wr` as well – Stupid_Intern Dec 13 '15 at 17:18
  • 1
    Sure. If it is found then move it across. However, the second (inside) loop could be made much more efficient. Currently, you are not even exiting the loop when found in an inefficient manner. –  Dec 13 '15 at 17:21

1 Answers1

1

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.

Community
  • 1
  • 1