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

stevenash1367

New Member
Joined
Nov 14, 2011
Messages
30
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:)
 

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

John Davis

Well-known Member
Joined
Sep 11, 2007
Messages
3,457
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:

Code:
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

New Member
Joined
Nov 14, 2011
Messages
30
Well due to the recent lockout I have decided to become a excel expert.:LOL:

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

John Davis

Well-known Member
Joined
Sep 11, 2007
Messages
3,457
Well due to the recent lockout I have decided to become a excel expert.:LOL:

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

New Member
Joined
Nov 14, 2011
Messages
30

ADVERTISEMENT

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

John Davis

Well-known Member
Joined
Sep 11, 2007
Messages
3,457

ADVERTISEMENT

And yes its replacing irregardless.

Does this make any difference?

Code:
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

New Member
Joined
Nov 14, 2011
Messages
30
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>
 

Watch MrExcel Video

Forum statistics

Threads
1,122,519
Messages
5,596,635
Members
414,083
Latest member
Mrsash

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top