Small VBA code needed for delete with criteria

[sooshil]

Hi all

I want to delete contents of a sheet based upon some criteria. I am very basic in VBA. I created Select and ClearContent by recording macro. But, I am not sure how to add criteria.
Here is my code.

Sub DeleteData()
  
  ' If B3 is not empty and not equal to ""
    Range("C5:D6").Select
    Selection.ClearContents
    
  ' If H3 is not empty and not equal to ""
    Range("I5:J6").Select
    Selection.ClearContents
     
    
End Sub

Now, I want to add the criteria as described on the comment.
The criteria cell is one column left and two column up of the first cell in range.

Do I have to write the if statement for every range I try to delete or it can be written once and works for every range?

 

[Joe4]

Try:

Sub DeleteData()
  
  ' If B3 is not empty and not equal to ""
    If Range("B3")<>"" Then Range("C5:D6").ClearContents
    
  ' If H3 is not empty and not equal to ""
    If Range("H3")<>"" Then Range("I5:J6").ClearContents         

End Sub

Do I have to write the if statement for every range I try to delete or it can be written once and works for every range?

How many ranges do you want to apply this to?
Is there any rhyme or reason regarding which ranges you want to check (B3, then H3, then what?)

 

[sooshil]

How many ranges do you want to apply this to?
Is there any rhyme or reason regarding which ranges you want to check (B3, then H3, then what?)

Hello Joe

Yes, there is absolutely a rhyme.
The criteria cells are as follows...
B3, H3, N3
B8, H8, N8
B13, H13, N13
B18, H18, N18

and so on...
last is B73, H73, N73

And the delete range starts at two cell down and one cell right. From that starting point I want to clear 4 column by 2 rows range.

 

[Joe4]

OK, this should do that:

Sub DeleteData()
  
  Dim rw As Long, cl As Long
  
  Application.ScreenUpdating = False
  
'   Update every 5 rows from 3 to 73
    For rw = 3 To 73 Step 5
'       Update every six columns from 2 (B) to N (14)
        For cl = 2 To 14 Step 6
'           Check to see if cell is not blank, then clear cells
            If Cells(rw, cl) <> "" Then Range(Cells(rw + 2, cl + 1), Cells(rw + 3, cl + 2)).ClearContents
        Next cl
    Next rw
    
  Application.ScreenUpdating = True

End Sub

Let me know if you have any questions about it.

 

[sooshil]

I am sorry. I give you the opposite criteria. I have to delete the ranges if the criteria is empty or equals to "".

 

[Joe4]

If B3 is not empty and B3 is not equal to ""

That is redundant.

If B3 is not empty and B3 is not equal to "", Delete C5:F6

That is what the code I posted does.
If it is not working for you, please give us an actual example, telling us exactly what is in in cell B3.

 

[sooshil]

I am very sorry. At first I gave you the wrong/opposite criteria.
I am able to fix that by replacing <> with an = sign.
That worked great.
Thank you Joe again.

Now, can I make this macro run automatically if I delete some data.
I have a named range 'Data' ranging B5:B14 in sheet DataSheet.
I keep entering data and delete from buttom or all at once frequently.
I want the macro we wrote to run automatically as soon as I delete a data from that range. All other time, I don't need that macro to be run.
Is it possible?

 

[Joe4]

Right-click on the sheet tab name at the bottom of the screen, select "View Code", and paste this coding in the VB Editor window that pops up (the code NEEDS to be in this exact Sheet module to work properly):

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, cell As Range
    Dim rw As Long, cl As Long
  
    Application.ScreenUpdating = False
    
'   See if updated cells are in the designated range
    Set rng = Intersect(Target, Range("B3:N73"))
    If rng Is Nothing Then Exit Sub
    
'   Loop through cells found in range
    For Each cell In rng
'       Check to see if updated cell is now blank
        If cell = "" Then
'           Check to see if one of designated rows/columns
            rw = cell.Row
            cl = cell.Column
            If (rw Mod 5 = 3) And (cl Mod 6 = 2) Then
'               Clear range
                Application.EnableEvents = False
                Range(Cells(rw + 2, cl + 1), Cells(rw + 3, cl + 2)).ClearContents
                Application.EnableEvents = True
            End If
        End If
    Next cell
    
    Application.ScreenUpdating = True

End Sub

I think that will do what you want automatically.