HI,
Try out the following:
Sub trial()
Dim rng As Range
Dim what(9) As String
what(1) = "FD"
what(2) = "EX"
what(3) = "NA"
what(4) = "NB"
what(5) = "NC"
what(6) = "HN"
what(7) = "CLD"
what(8) = "Location"
what(9) = "of"
For i = 1 To 9
Do
Set rng = ActiveSheet.UsedRange.Find(what(i))
If rng Is Nothing Then
Exit Do
Else
Rows(rng.Row).Delete
End If
Loop
Next i
End Sub
On 4/6/10, JsinSk <jsin...@gmail.com> wrote:
>
> Hello all fellow fellow Macro friends :)
>
> I have a short bit of code that I was wondering if it's possible to
> make it run more efficiently. When it runs currently it takes up to 1
> minute which seems like a long time.
>
> Notes: This is designed to remove an entire row if the condition is
> met. There is no *real* set limit on the number of potential rows, but
> in reality it shouldn't exceed 1,500 rows on a bad day. There is more
> code that runs after this but it's basic formatting stuff that dos not
> have a loop function in it.
>
> Regards,
> Jason
>
>
>
> Dim rng As Range
> Dim what As String
> Dim what1 As String
> Dim what2 As String
> Dim what3 As String
> Dim what4 As String
> Dim what5 As String
> Dim what6 As String
> Dim what7 As String
> Dim what8 As String
>
>
> what = "FD"
> what1 = "EX"
> what2 = "NA"
> what3 = "NB"
> what4 = "NC"
> what5 = "HN"
> what6 = "CLD"
> what7 = "Location"
> what8 = "of"
>
> Do
> Set rng = ActiveSheet.UsedRange.Find(what)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
>
> Do
> Set rng = ActiveSheet.UsedRange.Find(what1)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
>
> Do
> Set rng = ActiveSheet.UsedRange.Find(what2)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
>
> Do
> Set rng = ActiveSheet.UsedRange.Find(what3)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
>
> Do
> Set rng = ActiveSheet.UsedRange.Find(what4)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
>
> Do
> Set rng = ActiveSheet.UsedRange.Find(what5)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
> Do
> Set rng = ActiveSheet.UsedRange.Find(what6)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
> Do
> Set rng = ActiveSheet.UsedRange.Find(what7)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
> Do
> Set rng = ActiveSheet.UsedRange.Find(what8)
> If rng Is Nothing Then
> Exit Do
> Else
> Rows(rng.Row).Delete
> End If
> Loop
>
> --
>
> ----------------------------------------------------------------------------------
> Some important links for excel users:
> 1. Follow us on TWITTER for tips tricks and links :
> http://twitter.com/exceldailytip
> 2. Join our Facebook Group @
> http://www.facebook.com/group.php?gid=287779555678
> 3. Excel tutorials at http://www.excel-macros.blogspot.com
> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
> To post to this group, send email to excel-macros@googlegroups.com
>
> <><><><><><><><><><><><><><><><><><><><><><>
> HELP US GROW !!
>
> We reach over 6,800 subscribers worldwide and receive many nice notes about
> the learning and support from the group.Let friends and co-workers know they
> can subscribe to group at
> http://groups.google.com/group/excel-macros/subscribe
>
> To unsubscribe, reply using "remove me" as the subject.
>
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our Facebook Group @ http://www.facebook.com/group.php?gid=287779555678
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,800 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
