Small VBA code needed for delete with criteria

sooshil

Board Regular
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
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
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
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
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
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
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
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.
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Macro to copy values across rows and transposing them and add the user id
    [FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Hi,[/COLOR][/SIZE][/FONT] [FONT=Times New...
Top