Help with compacting & optimization (1 Viewer)

Sub Vader_Extract_Tel_Bills()
Application.ScreenUpdating = False
Range("C:C,D,E:E,F:F,G:G").Delete Shift:=xlToLeft
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Dim rng As Range
Dim Mime1, Mime2, Mime3, Mime4 As String
Mime1 = "/200"
Mime2 = "Vkupno:"
Mime3 = "ddv"
Mime4 = "mesecna"

Do
Set rng = ActiveSheet.Range("A:A").Find(Mime1)
If rng Is Nothing Then
Exit Do
Else
Rows(rng.Row).Delete
End If
Loop

Do
Set rng = ActiveSheet.Range("A:A").Find(Mime2)
If rng Is Nothing Then
Exit Do
Else
Rows(rng.Row).Delete
End If
Loop

Do
Set rng = ActiveSheet.Range("A:A").Find(Mime3)
If rng Is Nothing Then
Exit Do
Else
Rows(rng.Row).Delete
End If
Loop

Do
Set rng = ActiveSheet.Range("A:A").Find(Mime4)
If rng Is Nothing Then
Exit Do
Else
Rows(rng.Row).Delete
End If
Loop

Rows("1:2").Delete Shift:=xlUp

Dim X As Long
Dim LastRow As Long
Dim Evens As Range
With ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For X = 2 To LastRow Step 2
.Range("A" & X & ":J" & X).Copy .Cells(X - 1, "C")
.Range("A" & X & ":J" & X).Clear
Next
End With

Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("C:C").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("A:A,C:C").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

Howdy. A little further explanation might be in order.

I`m certain that the loops could gain on speed if they could somehow be optimized, or maybe replace them with something else that could speed things up. Anyway i can see that i`m doing something wrong from the start but i can`t figure out a better solution. The general idea is this: the macro/code it`s getting the job done (in 00:02:11 exactly - variable between 20000-50000 rows & 7 columns of data), but i`m asked to make it under 40 sec. So my problem is time and i have no idea how to gain on it!?
And I must say that I`m really glad that you (SHADES) posted the first reply, because i really learned so much from you! So thank you just for the reply anyway!!!

A couple of simple things first
Dim Mime1, Mime2, Mime3, Mime4 As String

Use 4 Dim statements, only Mime4 will be declared as a string the others will be Variants which I believe is less efficient.

Columns("A:A").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete

Why not set the exact range of rows for this and all of your work rather than search all 60000+ rows which is what I think you will do.

Brian

I wonder if a construct like this would perform quicker

Brian