Delete Rows with Loop Statement

[Brennan]

I have the following code. I am trying to get this code to delete all of the
rows that are not equal to the "name." When I turn on the screen updates I
can see it doing what I want it to do, but then it wigs out at the end and
turns into a white screen. Any help would be appreciated. Thanks

Brennan

Do

If ActiveCell <> name Then

ActiveCell.EntireRow.Delete

End If

Loop Until IsEmpty(ActiveCell.Offset(0, -2))

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

 

[Bob Phillips]

If ActiveCell <> name Then

If rng Is Nothing then

Set rng = activecell.entirerow
Else

Set rng = Union(rng, ActiveCell.EntireRow)
End If
End If

Loop Until IsEmpty(ActiveCell.Offset(0, -2))

If Not rng Is Nothing Then rng.Delete

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Brennan]

Hi Bob,

When I run the code, the sheet keeps blowing up on me. Here is the final
version of the code that I used. Please let me know what I need to change.
Thanks again!

rivate Sub MNGName_Change()
Dim name As String
Dim rng As range

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

Sheets("Sheet1").Select
range("A1").Select

ActiveCell = Me.MNGName.Value
name = ActiveCell

Unload Splash

Sheets("Outlook").Select
range("c3").Select

Do
If ActiveCell <> name Then
If rng Is Nothing Then
Set rng = ActiveCell.EntireRow
Else
Set rng = Union(rng, ActiveCell.EntireRow)
End If
End If
Loop Until IsEmpty(ActiveCell.Offset(0, -2))
If Not rng Is Nothing Then rng.Delete

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With


End Sub

 

[Bob Phillips]

I had to strip it down to test it, I don't have the form. I had to add a
line to move the activecell on but this version worked for me

Private Sub MNGName_Change()
Dim name As String
Dim rng As Range

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Sheets("Sheet1").Select
Range("A1").Select

ActiveCell.Value = Me.MNGName.Value
name = ActiveCell.Value

Unload Splash

Sheets("Outlook").Select
Range("C3").Select

Do
If ActiveCell.Value <> name Then

If rng Is Nothing Then

Set rng = ActiveCell.EntireRow
Else

Set rng = Union(rng, ActiveCell.EntireRow)
End If
End If

ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -2))

If Not rng Is Nothing Then rng.Delete

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Brennan]

It worked - thanks for your help!

B