excelvba

Deleting rows from Excel sheet based on the values in column A and Column H


I want to delete rows in an Excel sheet based on values in Column A and Column H.

For example,
if Column A is "A", delete rows if Column H is "Z" or "Y" or "X";
if Column A is "B", delete rows if Column H is "X" or "W" or "V", etc.

My intent is for the Column A statement to refer to the cell value, and the Column H statement to refer to an array list.

The code I have deletes rows based on Column A's value:

Dim LastRow As Long
Dim rowNum As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For rowNum = LastRow To 1 Step -1
    If (Range("A" & rowNum).Value = "A" And Range("H" & rowNum).Value = [reference to A list]) _
      Or (Range("A" & rowNum).Value = "B" And Range ("H" & rowNum).Value = [reference to B list]) Then
        Rows(rowNum).Delete
    End If
Next rowNum

Solution

  • Delete Rows When Multiple Criteria in Multiple Columns

    enter image description here

    Sub DeleteMultiMatchingRows()
    
        Const COLS_LIST As String = "A,H"
        Const CRITS_LIST As String = "A;X,Y,Z|B;U,V,W,X,Y|C;W,X"
    
        Dim Cols() As String: Cols = Split(COLS_LIST, ",")
        Dim Crits() As String: Crits = Split(CRITS_LIST, "|")
        
        Dim nUpper As Long: nUpper = UBound(Crits)
        Dim cJag() As Variant: ReDim cJag(0 To nUpper)
        Dim cArr() As Variant: ReDim cArr(0 To 1)
        
        Dim SplitCrits() As String, n As Long
        
        For n = 0 To nUpper
            cJag(n) = cArr
            SplitCrits = Split(Crits(n), ";")
            cJag(n)(0) = SplitCrits(0)
            cJag(n)(1) = Split(SplitCrits(1), ",")
        Next n
        
        Erase SplitCrits
        Erase cArr
        Erase Crits
            
        Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
        Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
        Dim r As Long, EqualString As String, MatchString As String
    
        For r = LastRow To 2 Step -1
            For n = 0 To nUpper
                EqualString = CStr(ws.Cells(r, Cols(0)).Value)
                If StrComp(EqualString, cJag(n)(0), vbTextCompare) = 0 Then
                    MatchString = CStr(ws.Cells(r, Cols(1)).Value)
                    If IsNumeric(Application.Match(MatchString, cJag(n)(1), 0)) Then
                        'Debug.Print r, EqualString, MatchString, ws.Rows(r).Address
                        'ws.Rows(r).Interior.Color = vbYellow
                        ws.Rows(r).Delete
                        Exit For
                    End If
                End If
            Next n
        Next r
    
    End Sub
    

    Immediate Window Results

     21           C             X             $21:$21
     20           C             X             $20:$20
     18           C             W             $18:$18
     16           C             X             $16:$16
     15           B             V             $15:$15
     13           C             W             $13:$13
     11           A             X             $11:$11
     7            B             Y             $7:$7
     5            A             X             $5:$5
     2            B             Y             $2:$2