Small VBA code needed for delete with criteria

sooshil

Board Regular
Joined
Feb 21, 2013
Messages
87
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.

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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,178
Office Version
365
Platform
Windows
Try:

Code:
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?)
 
Last edited:

sooshil

Board Regular
Joined
Feb 21, 2013
Messages
87
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,178
Office Version
365
Platform
Windows
OK, this should do that:
Code:
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.
 
Last edited:

sooshil

Board Regular
Joined
Feb 21, 2013
Messages
87
I am sorry. I give you the opposite criteria. I have to delete the ranges if the criteria is empty or equals to "".
 
Last edited:

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,178
Office Version
365
Platform
Windows
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

Board Regular
Joined
Feb 21, 2013
Messages
87
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,178
Office Version
365
Platform
Windows
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):
Code:
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.
 

Forum statistics

Threads
1,078,525
Messages
5,340,974
Members
399,401
Latest member
poiter54

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top