delete entire row based on value

[Gauthier]

Hi there...below is the code currently contained in my workbook...i should
pre-empt with the fact that my VBA knowledge is basic at best - and i'm
using excel 2000...

My "history data" was actually a .txt document, that i converted to excel
using the delimited function...there's a lot of giberish and blank rows that
i want to DELETE...

i've determined the FIELD contents, for the ROWS that i wish to KEEP, and
would appreciate any assistance in establishing the code...

the FIELD contents for the ROWS i wish to KEEP are as follows:

- Column A contains "SEQ: T"
- Column A contains "TOTAL"
- Column B contains "SVC"
- Column C contains "EXCHANGE RATE:" note-the text EXCHANGE RATE: is
followed by a series of exchange rates that vary - but as long as it STARTS
with "EXCHANGE RATE:" keep the row

appreciate your assistance!
Sandi

----------------------------------------------------------------------------
-----

Sub FormatHistory()

' TURNS SCREEN UPDATING OFF
Application.ScreenUpdating = False

' STATUS BAR MESSAGE IS ACTIVATED
Application.StatusBar = "Formatting Report, Please Wait..."

' INSERTS FORMULA INTO COLUMN I TO SUBTRACT COLUMNS E,F,G, FROM H
("TOTAL")
' TO ROWS BEGINNING WITH "TOTAL"

' EXTENDS FORMULAS IN COLUMN I TO END OF ROW
Set SH = ThisWorkbook.Worksheets("simhistory")

' FINDS THE LAST ROW OF ACTUAL DATA
LR = SH.Range("A65536").End(xlUp).Row

' THIS CLEARS OUT ALL OF THE FORMULAES FROM COLUMN I
SH.Range("I2:I65536").ClearContents

' THIS ADDS THE FORMULAS TO COLUMN I
If LR > 1 Then
'IF THERE IS AT LEAST 1 ROW OF DATA, THEN IT WILL PUT IN THESE
'FORMULAS IN ROW 2 (FORMULA TO CALCULATE REV. FOR $50+)
SH.Range("I2").Formula =
"=IF(A2=""TOTAL"",IF(H2>0,H2-E2-F2-G2,""""))"
If LR > 2 Then
'IF THERE IS MORE THAN 1 ROW OF DATA, THEN IT WILL FILL DOWN THE
'FORMULA IN I2 ONTO ALL THE OTHER NEEDED ROWS
SH.Range("I2:I" & LR).FillDown
End If
End If

' FORMATS COLUMN I TO CURRENCY
Range("I:I").Select
Selection.NumberFormat = "#,##0.00"

Range("I1").Select
' STATUS BAR MESSAGE IS DEACTIVATED
Application.StatusBar = False

' TURNS SCREEN UPDATING ON
Application.ScreenUpdating = True

MsgBox "Report has been formatted!"

End Sub

 

[Tom Ogilvy]

Sub ClearRows()
Dim rng As Range
Columns(1).Insert
FindData "SEQ: T", 1
FindData "TOTAL", 1
FindData "SVC", 2
FindData "EXCHANGE RATE:", 3
On Error Resume Next
Set rng = Columns(1).SpecialCells(xlBlanks)
On Error GoTo 0
rng.Select
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
Columns(1).Delete
Range("A1").Select
End Sub

Sub FindData(sStr As String, col As Long)
Dim rng As Range, faddr As String
Set rng = Columns(col + 1).Find(sStr, _
LookIn:=xlValues, LookAT:=xlPart)
If Not rng Is Nothing Then
faddr = rng.Address
Do
Cells(rng.Row, 1).Value = "Keep"
Set rng = Columns(col + 1).FindNext(rng)
Loop While rng.Address <> faddr
End If
End Sub

 

[Bernie Deitrick]

Gauthier,

Try this sub, which will place a formula in column AA on which to base the
deletion. This assumes that you have headers in row 1.

Sub DeleteRows()
Dim myRow As Long
Dim myR As Range

myRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Range("AA1").Value = "Save Key"
Range("AA2:AA" & myRow).Formula = _
"=IF(OR(A2=""SEQ: T"",A2=""TOTAL"",B2=""SVC""," & _
"LEFT(C2,14)=""EXCHANGE RATE:""),""Keep"",""Delete"")"
Range("AA2:AA" & myRow).Value = Range("AA2:AA" & myRow).Value
Columns("A:AA").Sort Key1:=Range("AA2"), _
Order1:=xlDescending, Header:=xlYes
Set myR = Range("AA2:AA" & myRow).Find(What:="Delete", _
After:=Range("AA2"), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Range(myR, Range("AA65536").End(xlUp)).EntireRow.Delete
Range("AA1").EntireColumn.Delete
End Sub

HTH,
Bernie
MS Excel MVP