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

 

[John Davis]

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

Have you ever played basketball for the Phoenix Suns?

Maybe:

Sub stevenash1367()

Dim i As Long

Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = lr To 2 Step -1

    If Range("Q" & i).Value <> "ABC" Or Range("Q" & i).Value <> "EFG" Then
    
        Range("S" & i).Cut Range("Q" & i)
        Range("T" & i).Cut Range("R" & i)
        
    End If
    
Next i

'

End Sub

 

[stevenash1367]

Well due to the recent lockout I have decided to become a excel expert.

Thanks for the help but it is basically replacing column Q and R with S and T.

 

[John Davis]

Well due to the recent lockout I have decided to become a excel expert.

Thanks for the help but it is basically replacing column Q and R with S and T.

Sorry about the lockout, but you millionaires should have nothing to complain about.

Does it replace irregardless of "ABC" and "EFG" lines? Is it absolutely required for cell shift. Let me know, and I'll try to come up with something.

 

[stevenash1367]

Cell shift is not necessary but would be helpful. Thanks for your help again!

 

[stevenash1367]

And yes its replacing irregardless.

 

[John Davis]

And yes its replacing irregardless.

Does this make any difference?

Sub stevenash1367()

Dim i As Long

Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = lr To 2 Step -1

Range(Range("Q" & i), Range("T" & i)) = Trim(Range(Range("Q" & i), Range("T" & i)))

    If Range("Q" & i).Value = "ABC" Or Range("Q" & i).Value = "EFG" Then
    
        Range("Q" & i).Value = Range("Q" & i).Value
        
    Else
    
        Range(Range("Q" & i), Range("R" & i)).Value = Range(Range("S" & i), Range("T" & i)).Value
        
        Range(Range("S" & i), Range("T" & i)).Delete shift:=xlToLeft
    
        
    End If
    
Next i

'

End Sub

 

[stevenash1367]

Getting a error message now "Type mismatch"

 

[John Davis]

Getting a error message now "Type mismatch"

Which line is highlighted when you receive the error?

 

[stevenash1367]

If Range("Q" & i).Value = "ABC" Or Range("Q" & i).Value = "EFG" Then Range("Q" & i).Value = Range("Q" & i).Value Else Range(Range("Q" & i), Range("R" & i)).Value = Range(Range("S" & i), Range("T" & i)).Value Range(Range("S" & i), Range("T" & i)).Delete shift:=xlToLeft

I was debugging and got an error when I am at this step.
</pre>