Deleting Rows on condition & Long processing time
 

Problem # 1 : Delete Rows where
Col "A" Cells are < "F1PP601
Row 1 Col A Col B
Row 2 F601 AWP
Row 3 F1PPM60602 AW2
Row 4 F1PPM60601 AWP
Row 5 F1PPM60601 AW3
Row 6 F1PPM60603 AW2
Row 7 F1PPM60602 AW1
Row 8 F1PPM60601 AW$
..
Sub DeleteRows()
Dim strCheck As String
Dim LRow As Long, i As Long
Dim varData As Variant

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

strCheck = "F1PPM60601,F1PPM60602"

With Sheets("PM4")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
varData = .Range("P2:P" & LRow)
For i = UBound(varData) To LBound(varData) Step -1
If InStr(strCheck, varData(i, 1)) = 0 Then
Rows(i + 1).Delete
End If
Next
End With
With Sheets("PM4")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
varData = .Range("BE2:BE" & LRow)
For i = UBound(varData) To LBound(varData) Step -1
With .Cells(i, "BE")
If Not IsError(.Value) Then
If .Value = "AWP" Then .EntireRow.Delete
End If
End With
Next
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Deleting Rows on condition & Long processing time
 

Hi J.P.,

Am Mon, 4 May 2015 10:42:36 -0700 (PDT) schrieb JeanPierre Charron:

modify strCheck to the expected string:

Sub DeleteRows()
Dim strCheck As String
Dim LRow As Long, i As Long
Dim varData As Variant

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

strCheck = "F1PPM60601"

With Sheets("PM4")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
varData = .Range("A2:A" & LRow)
For i = UBound(varData) To LBound(varData) Step -1
If strCheck < varData(i, 1) Then
Rows(i + 1).Delete
End If
Next
End With

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


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Deleting Rows on condition & Long processing time
 

Perhaps...

Sub DeleteRows2()
Dim lLastRow&, n&, lCalcMode&
Dim wks As Worksheet

Const sCheck$ = "F1PPM60601" '//edit to suit
Const lNoCalc = -4135
Const lStartRow& = 9 '//edit to suit
Set wks = ActiveWorkbook.Sheets("PM4") '//edit to suit

With Application
lCalcMode = .Calculation: .Calculation = lNoCalc
.ScreenUpdating = False
End With

On Error GoTo ErrExit
With wks
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For n = lLastRow To lStartRow Step -1
If sCheck < .Cells(n, 1).Value Then .Rows(n).Delete
Next 'n
End With

ErrExit:
With Application
.Calculation = lCalcMode: .ScreenUpdating = True
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

xem truyện tranh nữ hoàng rắc rối tập cuối Trong 1 cuộc thi vấn đáp:
GV: Trên 1 máy bay có 500 cục gạch,
rơi 1 cục hỏi còn mấy cục?
HS: Dễ quá! 499 cục
.
.
...
GV: Làm thế nào trong 3 bước bỏ đc
con voi vào tủ lạnh?
HS: B1: mở tủ lanh B2: nhét con voi vào Xem thêm xem truyện tranh shin cậu bé bút chì tập 1