Macro to not delete row if cell contains XX"Total"

[BMAY]

I am new to Macros. I have made a macro that I would like some help with. The last function does not work properly. I need it keep just the rows that contain "xx Total" in column "R".

Code:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 3/10/2009 by bmay
'

'
Application.ScreenUpdating = False
Windows("macro book.xls").Activate
Rows("23:43").Select
Selection.Copy
Windows("Run.xls").Activate
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("BD1").Select
ActiveCell.FormulaR1C1 = "order"
Range("BD2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-38],'[macro book.xls]Sheet1'!R1C1:R30C2,2,FALSE)"
If IsEmpty(ActiveCell) Then Exit Sub
Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown
Range("BD:BD").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
Range("AP1").Activate
Selection.Sort Key1:=Range("BD2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=18, Function:=xlSum, TotalList:=Array(55), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("AP1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Columns("BC:BC").Select
Selection.NumberFormat = "0.00"
Sheets("Run").Copy After:=Sheets(1)
Sheets("Run (2)").Name = "data"
Dim LR As Long, i As Long
With Sheets("data")
LR = .Range("R" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
If Not .Range("O" & i).Value Like "*Total*" Then .Rows(i).Delete
Next i
End With
Application.ScreenUpdating = True
End Sub

 

[VoG]

Then shouldn't it be

For I = LR To 2 Step -1
    If Not .Range("R" & I).Value Like "*Total*" Then .Rows(I).Delete
Next I

 

[BMAY]

It was that easy!! Sorry to bother you. Now I have to do the loser walk.

 

[BMAY]

Thanks VoG.

Could someone help with another part of this code? I would like the vlookup to validate and stop the macro and return a message if any invalids

this section of code
Range("BD2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-38],'[macro book.xls]Sheet1'!R1C1:R30C2,2,FALSE)"
If IsEmpty(ActiveCell) Then Exit Sub
Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown
Range("BD:BD").Select

This section looks at row "R" and lookups from another sheet. but I want it to first make sure every one of the column "R" data lines are in the lookup array.

I am trying to make this Macro so that I can have drones run the report and break it down to the useful info without them flubbing it. So I want it idiot proof before I release.
BMay

 

[VoG]

Perhaps

Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown

For Each cel In Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    If IsError(cel.Value) Then
        MsgBox "Lookup error in " & cel.Address(False, False)
    End If
Next cel

 

[BMAY]

How do I tell it to End Sub if this "IF" catches something to be fixed. So they can go fix the data and run the macro again.

 

[VoG]

Something like this

Dim cel As Range, msg As String, MyErr As Boolean
For Each cel In Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1))
    If IsError(cel.Value) Then
        msg = msg & cel.Address(False, False) & ", "
        MyErr = True
    End If
Next cel
If MyErr Then
    MsgBox "Lookup error in" & vbCrLf & Left(msg, Len(msg) - 2)
    Exit Sub
End If

 

[BMAY]

That did not even display an error for the one bit of bad info. Edit: It did not catch the one row that is wrong.