Delete rows in a spreadsheet where <condition> when column of <condition> is unknown [closed]

It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center. Closed 10 years ago. 开发者_开发技巧

I need to find the word "Overdue" and "Due" in a spreadsheet, but the column they appear in will be variable, as will the number of records (rows). I need to delete all rows that do NOT have these values in the data, then total up the data left on the sheet after the others have been deleted. Any clues?

---

You can try something like this.

Put this into a macro to run

Sub Macro1()
Dim sheet As Worksheet
Dim usedRange As Range

    Set sheet = ActiveSheet
    Set usedRange = sheet.usedRange

Dim rowCount As Integer
Dim columnCount As Integer
Dim iRow As Integer
Dim iColumn As Integer

    rowCount = usedRange.Rows.Count
    columnCount = usedRange.Columns.Count

    For iRow = rowCount To 1 Step -1
        For iColumn = 1 To columnCount
            If ((InStr(1, LCase(usedRange(iRow, iColumn)), "overdue") > 0) Or (InStr(1, LCase(usedRange(iRow, iColumn)), "due") > 0)) Then
                usedRange.Range(Cells(iRow, 1), Cells(iRow, columnCount)).Delete
            End If
        Next iColumn
    Next iRow

End Sub

---

You could also try something with ADO.

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim strWhere As String
Dim i As Integer

''http://support.microsoft.com/kb/246335

strFile = ActiveWorkbook.FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM [Sheet1$] AS s "

rs.Open strSQL, cn, 3, 3

For i = 0 To rs.fields.Count - 1
    strWhere = strWhere & " AND (UCase(s.[" _
        & rs.fields(i).Name & "] ) Not Like '%DUE%' Or s.[" _
        & rs.fields(i).Name & "] Is Null) "
Next

strSQL = strSQL & " WHERE " & Mid(strWhere, 5)
rs.Close

rs.Open strSQL

For i = 0 To rs.fields.Count - 1
    Sheets("Sheet2").Cells(1, i + 1) = rs.fields(i).Name
Next

Worksheets("Sheet2").Cells(2, 1).CopyFromRecordset rs

---

Excel should be able to coerce any value into a string except an error. So if you have formulas that return errors, that may be causing the type mismatch. Here's another way using the Find method that would avoid that problem. Find can be slower that looping through the columns, but if you don't have a ton of data, you won't notice it.

Sub DeleteOverDue()

    Dim i As Long
    Dim rFound As Range

    'Loop backward through the used range
    For i = Sheet1.usedRange.Rows.Count To 1 Step -1
        'Should find "due" and "overdue" because of xlPart
        Set rFound = Sheet1.usedRange.Cells(i, 1).EntireRow.Find("due", , xlValues, xlPart)
        'If it's not found, delete the row
        If rFound Is Nothing Then
            Sheet1.usedRange.Cells(i, 1).EntireRow.Delete
        End If
    Next i

End Sub

Note: This code deletes data so please use it on a copy of your real data until you know that it works for you.