Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
variation of "delete all except"
i have some code someone from here was gracious enought to provide while back. i am trying to create a variation to what i have. i woul like it to delete all except each criteria but i also want to keep th four rows immediately following each found exception. is thi possible? thanks in advance for your help-here is the code: Sub DeleteAllExcept() Dim Exceptions As Variant Dim cell As Range, LastCell As Range Dim MyDelRng As Range Dim WB As Workbook, SH As Worksheet Dim CountryCol As String Dim blKeep As Boolean Exceptions = Array("RH - MONTH TOTAL:", "RO - MONTH TOTAL:", "SO MONTH TOTAL:", "SH - MONTH TOTAL:") Set WB = Workbooks("poreport-test.xls") Set SH = WB.Sheets("poreport") CountryCol = "A" Set LastCell = SH.Cells(Rows.Count, CountryCol).End(xlUp) For Each cell In Range(SH.Cells(1, CountryCol), LastCell) blKeep = False On Error Resume Next blKeep = Application.Match(cell.Value, Exceptions, 0) On Error Resume Next If Not blKeep Then If MyDelRng Is Nothing Then Set MyDelRng = cell Else Set MyDelRng = Union(cell, MyDelRng) End If End If Next cell If Not MyDelRng Is Nothing Then MyDelRng.EntireRow.Delete Else MsgBox "No data found to delete" End If End Su -- acarri ----------------------------------------------------------------------- acarril's Profile: http://www.excelforum.com/member.php...fo&userid=1002 View this thread: http://www.excelforum.com/showthread.php?threadid=27302 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
variation of "delete all except"
Try this against a copy of your worksheet.
Option Explicit Sub DeleteAllExcept() Dim Exceptions As Variant Dim MyDelRng As Range Dim WB As Workbook, SH As Worksheet Dim CountryCol As String Dim FirstRow As Long Dim LastRow As Long Dim iRow As Long Exceptions = Array("RH - MONTH TOTAL:", "RO - MONTH TOTAL:", _ "SO - MONTH TOTAL:", "SH - MONTH TOTAL:") Set WB = Workbooks("poreport-test.xls") Set SH = WB.Sheets("poreport") 'for testing 'Set SH = ActiveSheet CountryCol = "A" With SH FirstRow = 1 LastRow = .Cells(.Rows.Count, CountryCol).End(xlUp).Row iRow = 1 Do If iRow LastRow Then Exit Do End If If IsError(Application.Match(.Cells(iRow, _ CountryCol).Value, Exceptions, 0)) Then 'not found If MyDelRng Is Nothing Then Set MyDelRng = .Cells(iRow, "A") Else Set MyDelRng = Union(.Cells(iRow, "A"), MyDelRng) End If iRow = iRow + 1 Else 'skip around this one and the next 4 iRow = iRow + 1 + 4 End If Loop End With If Not MyDelRng Is Nothing Then MyDelRng.EntireRow.Delete Else MsgBox "No data found to delete" End If End Sub acarril wrote: i have some code someone from here was gracious enought to provide a while back. i am trying to create a variation to what i have. i would like it to delete all except each criteria but i also want to keep the four rows immediately following each found exception. is this possible? thanks in advance for your help-here is the code: Sub DeleteAllExcept() Dim Exceptions As Variant Dim cell As Range, LastCell As Range Dim MyDelRng As Range Dim WB As Workbook, SH As Worksheet Dim CountryCol As String Dim blKeep As Boolean Exceptions = Array("RH - MONTH TOTAL:", "RO - MONTH TOTAL:", "SO - MONTH TOTAL:", "SH - MONTH TOTAL:") Set WB = Workbooks("poreport-test.xls") Set SH = WB.Sheets("poreport") CountryCol = "A" Set LastCell = SH.Cells(Rows.Count, CountryCol).End(xlUp) For Each cell In Range(SH.Cells(1, CountryCol), LastCell) blKeep = False On Error Resume Next blKeep = Application.Match(cell.Value, Exceptions, 0) On Error Resume Next If Not blKeep Then If MyDelRng Is Nothing Then Set MyDelRng = cell Else Set MyDelRng = Union(cell, MyDelRng) End If End If Next cell If Not MyDelRng Is Nothing Then MyDelRng.EntireRow.Delete Else MsgBox "No data found to delete" End If End Sub -- acarril ------------------------------------------------------------------------ acarril's Profile: http://www.excelforum.com/member.php...o&userid=10027 View this thread: http://www.excelforum.com/showthread...hreadid=273021 -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel - Golf - how to display "-2" as "2 Under" or "4"as "+4" or "4 Over" in a calculation cell | Excel Discussion (Misc queries) | |||
Excel "Move or Copy" and "Delete" sheet functions | Excel Worksheet Functions | |||
change "true" and "false" to "availble" and "out of stock" | Excel Worksheet Functions | |||
Count occurences of "1"/"0" (or"TRUE"/"FALSE") in a row w. conditions in the next | New Users to Excel | |||
Adding "New" "Insert" "Delete" into a workbook to change from data 1 to data 2 etc | Excel Programming |