Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Deleting Rows if certain criteria isnt met
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 37
Default Deleting Rows if certain criteria isnt met
Hopefully someone can help, the code below works fine for these two macros,
though there must be an easier way to achieve what I want.

What I want is to delete any rows if the criteria isnt met in column D. If
column D has either 1103 or 1203 or 1303 or 2103, then keep that column. if
it doesnt meet this criteria then delete the column.

The code below works, however I have to use the 2 macros to achieve it, any
help is appreciated.

Big H


Sub DeletePlants_ShowSpares()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

'ElseIf .Cells(Lrow, "D").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "***" in Column D,
case sensitive.
ElseIf .Cells(Lrow, "D").Value = "1101" Or _
.Cells(Lrow, "D").Value = "1102" Or _
.Cells(Lrow, "D").Value = "1201" Or _
.Cells(Lrow, "D").Value = "1202" Or _
.Cells(Lrow, "D").Value = "1302" Or _
.Cells(Lrow, "D").Value = "2102" Or _
.Cells(Lrow, "D").Value = "3101" Or _
.Cells(Lrow, "D").Value = "3102" Or _
.Cells(Lrow, "D").Value = "CASE" Or _
.Cells(Lrow, "D").Value = "HPMC" Or _
.Cells(Lrow, "D").Value = "OBCA" Or _
.Cells(Lrow, "D").Value = "OBDD" Or _
.Cells(Lrow, "D").Value = "OBRD" Or _
.Cells(Lrow, "D").Value = "TRBD" Or _
.Cells(Lrow, "D").Value = "CBCC" Or _
.Cells(Lrow, "D").Value = "CBSD" Or _
.Cells(Lrow, "D").Value = "CBSL" Or _
.Cells(Lrow, "D").Value = "COSL" Or _
.Cells(Lrow, "D").Value = "CPSD" Or _
.Cells(Lrow, "D").Value = "CPSL" Or _
.Cells(Lrow, "D").Value = "CTSL" Or _
.Cells(Lrow, "D").Value = "CV01" Or _
.Cells(Lrow, "D").Value = "CV05" Or _
.Cells(Lrow, "D").Value = "DISC" Or _
.Cells(Lrow, "D").Value = "DSFT" Then .Rows(Lrow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

Sub DeletePlants_ShowSpares1()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

'ElseIf .Cells(Lrow, "D").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "***" in Column D,
case sensitive.
ElseIf .Cells(Lrow, "D").Value = "ENUL" Or _
.Cells(Lrow, "D").Value = "FNSD" Or _
.Cells(Lrow, "D").Value = "FNSL" Or _
.Cells(Lrow, "D").Value = "HCAS" Or _
.Cells(Lrow, "D").Value = "6103" Or _
.Cells(Lrow, "D").Value = "61MP" Or _
.Cells(Lrow, "D").Value = "CTSD" Or _
.Cells(Lrow, "D").Value = "DB01" Or _
.Cells(Lrow, "D").Value = "HSMW" Or _
.Cells(Lrow, "D").Value = "ISLS" Or _
.Cells(Lrow, "D").Value = "ISTR" Or _
.Cells(Lrow, "D").Value = "LAF" Or _
.Cells(Lrow, "D").Value = "PW03" Or _
.Cells(Lrow, "D").Value = "PW05" Or _
.Cells(Lrow, "D").Value = "PW07" Or _
.Cells(Lrow, "D").Value = "RNGS" Or _
.Cells(Lrow, "D").Value = "SCAM" Or _
.Cells(Lrow, "D").Value = "SDUL" Or _
.Cells(Lrow, "D").Value = "SHFT" Or _
.Cells(Lrow, "D").Value = "SUND" Or _
.Cells(Lrow, "D").Value = "TNSD" Or _
.Cells(Lrow, "D").Value = "TNSL" Or _
.Cells(Lrow, "D").Value = "FAST" Or _
.Cells(Lrow, "D").Value = "TSPR" Or _
.Cells(Lrow, "D").Value = "WCFB" Then .Rows(Lrow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Deleting Rows if certain criteria isnt met
Using a little bit of Algebra we get


ElseIf (.Cells(Lrow, "D").Value < "1103") And _
(.Cells(Lrow, "D").Value < "1203") And _
(.Cells(Lrow, "D").Value < "1303") And _
(.Cells(Lrow, "D").Value < "2103") Then .Rows(Lrow).Delete
End If


"Big H" wrote:

Hopefully someone can help, the code below works fine for these two macros,
though there must be an easier way to achieve what I want.

What I want is to delete any rows if the criteria isnt met in column D. If
column D has either 1103 or 1203 or 1303 or 2103, then keep that column. if
it doesnt meet this criteria then delete the column.

The code below works, however I have to use the 2 macros to achieve it, any
help is appreciated.

Big H


Sub DeletePlants_ShowSpares()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

'ElseIf .Cells(Lrow, "D").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "***" in Column D,
case sensitive.
ElseIf .Cells(Lrow, "D").Value = "1101" Or _
.Cells(Lrow, "D").Value = "1102" Or _
.Cells(Lrow, "D").Value = "1201" Or _
.Cells(Lrow, "D").Value = "1202" Or _
.Cells(Lrow, "D").Value = "1302" Or _
.Cells(Lrow, "D").Value = "2102" Or _
.Cells(Lrow, "D").Value = "3101" Or _
.Cells(Lrow, "D").Value = "3102" Or _
.Cells(Lrow, "D").Value = "CASE" Or _
.Cells(Lrow, "D").Value = "HPMC" Or _
.Cells(Lrow, "D").Value = "OBCA" Or _
.Cells(Lrow, "D").Value = "OBDD" Or _
.Cells(Lrow, "D").Value = "OBRD" Or _
.Cells(Lrow, "D").Value = "TRBD" Or _
.Cells(Lrow, "D").Value = "CBCC" Or _
.Cells(Lrow, "D").Value = "CBSD" Or _
.Cells(Lrow, "D").Value = "CBSL" Or _
.Cells(Lrow, "D").Value = "COSL" Or _
.Cells(Lrow, "D").Value = "CPSD" Or _
.Cells(Lrow, "D").Value = "CPSL" Or _
.Cells(Lrow, "D").Value = "CTSL" Or _
.Cells(Lrow, "D").Value = "CV01" Or _
.Cells(Lrow, "D").Value = "CV05" Or _
.Cells(Lrow, "D").Value = "DISC" Or _
.Cells(Lrow, "D").Value = "DSFT" Then .Rows(Lrow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

Sub DeletePlants_ShowSpares1()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

'ElseIf .Cells(Lrow, "D").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "***" in Column D,
case sensitive.
ElseIf .Cells(Lrow, "D").Value = "ENUL" Or _
.Cells(Lrow, "D").Value = "FNSD" Or _
.Cells(Lrow, "D").Value = "FNSL" Or _
.Cells(Lrow, "D").Value = "HCAS" Or _
.Cells(Lrow, "D").Value = "6103" Or _
.Cells(Lrow, "D").Value = "61MP" Or _
.Cells(Lrow, "D").Value = "CTSD" Or _
.Cells(Lrow, "D").Value = "DB01" Or _
.Cells(Lrow, "D").Value = "HSMW" Or _
.Cells(Lrow, "D").Value = "ISLS" Or _
.Cells(Lrow, "D").Value = "ISTR" Or _
.Cells(Lrow, "D").Value = "LAF" Or _
.Cells(Lrow, "D").Value = "PW03" Or _
.Cells(Lrow, "D").Value = "PW05" Or _
.Cells(Lrow, "D").Value = "PW07" Or _
.Cells(Lrow, "D").Value = "RNGS" Or _
.Cells(Lrow, "D").Value = "SCAM" Or _
.Cells(Lrow, "D").Value = "SDUL" Or _
.Cells(Lrow, "D").Value = "SHFT" Or _
.Cells(Lrow, "D").Value = "SUND" Or _
.Cells(Lrow, "D").Value = "TNSD" Or _
.Cells(Lrow, "D").Value = "TNSL" Or _
.Cells(Lrow, "D").Value = "FAST" Or _
.Cells(Lrow, "D").Value = "TSPR" Or _
.Cells(Lrow, "D").Value = "WCFB" Then .Rows(Lrow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub



Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Deleting several rows with given criteria Rechie Excel Discussion (Misc queries) 7 October 20th 09 01:38 PM
Deleting rows with a two criteria JOUIOUI Excel Programming 1 June 6th 06 01:09 PM
Help - Deleting Rows on Text Criteria rayd8[_2_] Excel Programming 7 August 22nd 05 05:07 AM
Deleting rows based on criteria John Walker[_2_] Excel Programming 2 December 12th 03 08:37 PM
How can I detect an AutoFilter when the Criteria isnt Met Frederick Excel Programming 2 August 12th 03 02:43 PM


All times are GMT +1. The time now is 12:54 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement