Macro to delete cell and adjacent cell if criteria not met?

[stevenash1367]

I will give a watered down version:

Need to see if cells in column Q is equal to "ABC" or "EFG"
If not then would like to delete the cell in column Q and adjacent cell in column R and shift cell leftwards ( so cells in column S would become Q and T would become R).

So lets say Q501 is not equal to ABC or EFG then delete Q501 and R501 and move S501 and T501 over to Q501 and R501.

Thanks for your help

 

[chirp]

you can do something like this

Option Explicit
Option Base 1


Sub call_Del_Adjacent()

Dim doColumns, tVar

doColumns = Array(17, 19, 21) 'add any additional column numbers here

For Each tVar In doColumns
    Call del_Adjacent(CLng(tVar))
Next

End Sub

Sub del_Adjacent(colLet As Long)

Dim lRow As Long, i As Long
Dim tCell As Range, srchRng As Range, delRng As Range
Dim tArr, tVar
Dim tStr As String

'simple error handle
On Error GoTo exitSub

With ActiveSheet 'this is redundant but can be changed for better control/multisheet loops
    
    'gets the used range of the column in a roundabout way
    Set tCell = .Cells(.Rows.Count, colLet)
    
    'this returns the last row in specified column
    If tCell.Formula = vbNullString Then
        lRow = tCell.End(xlUp).Row
    Else
        lRow = .Rows.Count
    End If
    
    'sets the range to search
    Set srchRng = .Range(.Cells(1, colLet), .Cells(lRow, colLet))
    
    'defines an array, should speed things up
    If lRow = 1 Then
        tArr = Array(srchRng)
    Else
        tArr = srchRng
    End If

    
    'loops through the array checking values and adding any valid ranges to the delete range
    For Each tVar In tArr
        tStr = CStr(tVar)
        If tStr <> "EEG" And tStr <> "ABC" Then
                If delRng Is Nothing Then
                    Set delRng = .Cells(i + 1, colLet).Resize(1, 2)
                Else
                    Set delRng = Union(delRng, .Cells(i + 1, colLet).Resize(1, 2))
                End If
        End If
        
        i = i + 1
    Next
    
    If Not delRng Is Nothing Then delRng.Delete xlToLeft
End With

exitSub:
If Err.Number <> 0 Then
'some message here
End If
End Sub

 

[chirp]

i am not sure if this is what you would be looking for though, as it just loops through, do you mean that you want it to check Q,S and U for the matching words? this is more like an or operator

 

[stevenash1367]

Perfect. Thank you so much

 

[chirp]

no problem