Home > Blockchain >  Deleting rows from Excel, with the deletion rule changing based on the value in column A
Deleting rows from Excel, with the deletion rule changing based on the value in column A

Time:12-10

I am a coding rookie and attempting to delete rows in an excel sheet based on values in Column H, depending on what the value of Column A is. 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.

I know how to do this theoretically but am having trouble with the syntax. My intent is for the Column A statement to refer to the cell value, and the Column B statement compare the cell value to an array list that contains the values that should be deleted, deleting the row if the value is in the list. Any help or pointers in the right direction would be appreciated.

The code I have so far (that works great if I'm just deleting rows based on Column A's value) is as follows:

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

CodePudding user response:

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
  • Related