VBA Help. Delete Rows based on multiple criteria [closed] - vba

Question

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 6 years ago.
Improve this question
I am looking for some VBA help to clean up a Worksheet by deleting rows of data I do not need and keeping the rows of data I do based on multiple criteria.
I want to be able to keep any Row that equals "Subtotal:" in Column A and any Row that contains a number in column C while deleting all other rows that do not match that criteria.
Before Cleanup
Desired Result Requested

Answer 1

I wrote a function which should be able to get the job done.
So you can call the function from a sub and pass the column number you want to test (1 for "A"), the value you would like to test ("" for blank), the name of the worksheet you would like to test. The final argument is a Boolean value and if true it will delete on matching the value in the criteria, if not it will delete on anything else.
Function DeleteCol(iCol As Integer, strCriteria As String, strWSName As String, bPositive As Boolean)
Dim iLastCol As Integer
Dim wsUsed As Worksheet
Set wsUsed = ThisWorkbook.Worksheets(strWSName)
iLastRow = wsUsed.Cells(Rows.Count, iCol).End(xlUp).Row
For i = iLastRow To 1 Step -1
With wsUsed.Cells(i, iCol)
If bPositive Then
If .Value = strCriteria Then .EntireRow.Delete
Else
If .Value <> strCriteria Then .EntireRow.Delete
End If
End With
Next i
End Function
So to do what you requested above you could do:
Sub Delete()
Call DeleteCol(1, "Subtotal:", "CoolSheetName", False)
Call DeleteCol(3, "", "CoolSheetName", True)
End Sub

Answer 2

you may want to try the following (commented) code:
Option Explicit
Sub main()
With Worksheets("MySheetName") '<--| change "MySheetName" to your actual sheet name
With Intersect(.UsedRange, .Columns("A:C"))
.AutoFilter Field:=1, Criteria1:="<>Subtotal" '<--| filter column "A" cells not containing "Subtotal"
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Offset(1).Resize(.rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--| delete any filtered cell row
.AutoFilter '<--| show all data back
With .Offset(1, 2).Resize(.rows.Count - 1, 1) '<--| consider column "C" cell from header row (excluded) down
DeleteRows .Cells, xlCellTypeConstants, xlTextValues '<--| delete any "constant text" cell row
DeleteRows .Cells, xlCellTypeFormulas, xlTextValues '<--| delete any "formula text" cell row
DeleteRows .Cells, xlCellTypeBlanks, xlTextValues '<--| delete any "blank" cell row
End With
End With
End With
End Sub
Sub DeleteRows(rng As Range, cellType As XlCellType, cellsValue As XlSpecialCellsValue)
Dim f As Range
Set f = rng.SpecialCells(cellType, cellsValue)
If Not f Is Nothing Then f.EntireRow.Delete
End Sub