VBA Help deleting contents of a cell on worksheet change event

ASanders

New Member
Joined
Nov 8, 2010
Messages
24
Any help much appreciated. I have a spreadsheet and a worksheet change event which checks Column B and show's a message box when either "Personal" or "Corporate" is entered in the cell. It uses an OldValue variable to ensure the macro doesnt fire when the change is occurring to a currently blank cell.

What I also need the macro to do is to also delete the contents of columns D, E and F in the row corresponding to the cell whenever "Personal" or "Corporate" is entered in the cell. Code below.

Public OldValue As String
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("B2:BF" & Rows.Count)) Is Nothing Then Exit Sub

With Application
On Error GoTo ErrHandler
.EnableEvents = False
.Undo
OldValue = Target.Cells(1).Value
.Undo
.EnableEvents = True
ActiveCell.Offset(0, 1).Select

End With

With Target
If OldValue = "Personal" Then MsgBox "Please note products available are specific to either Personal or Corporate applications."
If OldValue = "Corporate" Then MsgBox "Please note products available are specific to either Personal or Corporate applications."

End With

ErrHandler:
Application.EnableEvents = True
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Number & vbNewLine & Err.Description
End If
End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
I have a spreadsheet and a worksheet change event which checks Column B and show's a message box when either "Personal" or "Corporate" is entered in the cell.
If you only care about monitoring the change in column B then why do you have this statement stretching out to column BF?

If Intersect(Target, Range("B2:BF" & Rows.Count)) Is Nothing Then Exit Sub

If you only care about entries in column B, substitute that line for this:

If target.Column <> 2 then exit Sub
 
Upvote 0
Thanks Tom. Was more interested in the deletion of contents from corresponding cells in Columns D, E and F?
 
Upvote 0
My point is, the Change event won't be triggered if you only limit it to column 2 (column B), meaning you can delete or do anything you want in the other columns such as D, E, and F.

If you must keep that Range Intersect statement in there as it is, then immediately after it stick in this line and see if it achieves what you want:

If IsEmpty(Target) Then Exit Sub
 
Upvote 0
Thanks Tom. Thats fine. I'll make that change to specify the range to Column 2. What I want to know is how I can code in the system to automatically delete the contents of the corresponding cells in D, E and F once the user changes the contents of Column 2 from 'Personal' to 'Corporate' or vice versa. I have it so a message box appears for each of these scenarios. I just need to add the delete part. Hope that makes more sense.
 
Upvote 0
Just to be clear, do you want this event to trigger if...

...Personal or Corporate is entered as a new item
or
...Personal or Corporate was originally in the cell and just got replaced by some other item
or
...either Personal or Corporate was originally in the cell, and/or Personal or Corporate was just entered.

Also, is the message box the same for both Personal and Corporate.
 
Upvote 0
There's a list validation in Column 2 so that only Personal or Corporate can be selected by the user. The original value is blank. If the user enters in either Personal or Corporate for the first time, I do not want the event to trigger at all. Only after that initial entry/selection of Personal or Corporate do I want the event to trigger on change. Thanks.
 
Upvote 0
OK then, the first thing you should do is delete the entire change event as you have it, including deleting this too:

Public OldValue As String



Next, paste this into your worksheet module and see if it does what you want:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:BF" & Rows.Count)) Is Nothing Then Exit Sub
With Target
If .Column <> 2 Or .Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
 
Dim OldVal$, NewVal$
NewVal = .Value
 
With Application
.EnableEvents = False
.Undo
OldVal = Target.Value
Target.Value = NewVal
.EnableEvents = True
End With
 
.Offset(0, 1).Activate
 
Select Case OldVal
Case "Personal", "Corporate"
MsgBox "Please note products available are specific to either Personal or Corporate applications.", , "FYI"
Range(Cells(.Row, 4), Cells(.Row, 6)).ClearContents
End Select
 
End With
End Sub
 
Upvote 0
That works perfect! Can I ask some questions on the code and what it does:

  1. "With Target If .Column <> 2 Or .Cells.Count > 1 Then Exit Sub" - what is the cells.count> 1 asking the system to evaluate?
  2. If IsEmpty(Target) Then Exit Sub - is that just telling the system to not fire the event if the cell's empty to begin with?
Thanks.
 
Upvote 0
  1. "With Target If .Column <> 2 Or .Cells.Count > 1 Then Exit Sub" - what is the cells.count> 1 asking the system to evaluate?

Translated:
If the cell being changed is not in column B then exit the Change event.
and
Even if the change being made is happening in column B, if more than one cell is attempted to be changed at the same time, then exit the change event.



2. If IsEmpty(Target) Then Exit Sub - is that just telling the system to not fire the event if the cell's empty to begin with?


No. It is VBA telling itself to do nothing if the Delete key is pressed, or if the cell is cleared of contents. The "if the cell's empty to begin with" is handled by the Select Case structure that evaluates the presence, or lack thereof, of "Personal", or "Corporate" having been the changed cell's contents before the change was made. If the cell was empty to begin with, that automatically qualifies as a resulting False evaluation and hence no action takes place to clear the cells in D:F.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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
Back
Top