Excel VBA prevent deletion of cells but allow edit - vba

I have made a spreadsheet which a user can enter a postcode and a quantity into 2 cells and I have other cells doing calculations and displaying the results.
I have added some VBA to prevent anyone from deleting rows and columns but I would like to prevent deletion of any cell within a range but also allow a user to make changes to certain cells but also prevent editing of cells with formula in there.
In cell E4, the user can enter a postcode. In E6, the user can enter a quantity. These can be edited but not deleted. E8:E9 and E11:E14 are all drop down lists (validation) which hold data from lists. These can be changed using the drop down but not deleted.
L10:L14, L16, L23:L27, L29, L30:L33 can all have their data edited but not deleted.
What would the VBA for this look like? I guess it would use the Worksheet_Change() event.

Is this what you are trying? Users can edit cell E4 and E6 but they cannot leave it empty. I am also assuming that the cell are not empty before hand.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("E4")) Is Nothing Then
If Len(Trim(Range("E4").Value)) = 0 Then Application.Undo
ElseIf Not Intersect(Target, Range("E6")) Is Nothing Then
If Len(Trim(Range("E6").Value)) = 0 Then Application.Undo
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
FOLLOWUP
Thanks that is what i want to do. What about the other ranges? Is it just a case of loads of IF THEN or can we use a CASE and loop through? – AdRock 2 mins ago
Add/Delete cell addresses from below as applicable.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("E4,E6,E8:E9,E11:E14,L10:L14,L16,L23:L27,L29,L30:L33")) Is Nothing Then
If Len(Trim(Target.Value)) = 0 Then Application.Undo
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub

You are partly right but Worksheet_Change() is triggered after the change, so after the deletion.
What I'd do is to have a hidden sheet to store the values entered by the user and then you can check in Worksheet_Change() whether the new value is empty (deleted) or not.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$4" Then
' check the previous value on the hidden sheet here, if changed, then save it, if empty, then restore it
End If
End Sub

Related

Delete 0's from cell upon entry

I want a macro so that when you enter a 0 into a particular cell/range of cells that it clears the cell.
I wrote a simple macro like this
Sub RemoveZeros()
'to remove 0 values that may be a result of a formula or direct entry.
For Each cell In Range("A1:D20")
If cell.Value = "0" Then cell.Clear
Next
End Sub
However, I have to run this after I have entered my values for it to clear. I would like the cell to clear if a 0 is entered. How do I do this?
I found a solution
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Value = 0 Then Target.ClearContents
Application.EnableEvents = True
End Sub
Thanks

Worksheet Change repeating steps [duplicate]

This question already has answers here:
Why MS Excel crashes and closes during Worksheet_Change Sub procedure?
(3 answers)
Closed 4 years ago.
I have reworked this macro for two days in a load of different ways to try to prevent steps from repeating but the range G2 step seems to run 3 or 4 times and the range G3 2 or 3 times. Does anyone have any ideas??
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Exit Sub
End If
End Sub
Your Worksheet_Change has succumbed to three of the most common mistakes in an event driven worksheet/workbook sub procedure.
You are not disabling events while making modifications to the worksheet. Each change triggers another event and the Worksheet_Change tries to run on top of itself over and over until it crashes.
Target could be a single cell or many cells. You need to deal with the possibility of Target being many cells by using Intersect to only get the affected cells within your range of possibilities.
If you disable events for any reason, make sure to provide error control that turns them back on if everything goes south. Typically, this can be done just before exiting the Worksheet_Change but not if you are going to use Exit Sub.
Here is my version of your procedure.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4, G2:G4")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("D4, G2:G4"))
Select Case trgt.Address(0, 0)
Case "G2"
Range("G3:G4") = Application.Transpose(Array("Division", "Team"))
'call check is below
Case "G3"
Range("G4") = "Team"
'call check is below
Case "D4", "G4"
'call check is below
End Select
Next trgt
Call check
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Your code is in the Worksheet_Change event. Every time the worksheet is changed this event fires, including when your code changes it
Range("g4").Value = "Team"
Thus you're stuck in a potentially infinite loop. To avoid this disable events before making any changes
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' this turns events off
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End Sub
You might need to enable or disable events within the subs you're calling too.
BTW I'd check if you really need those Exit Subs, if not you can just disable events once at the start and re-enable again at the end.

VBA - Open a UserForm by clicking anywhere in a specific column

I would like to build a makro in VBA which opens a UserForm when I click in a cell in a specific column, for more details look here.
With this code (from Mr.Burns):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A1")) Is Nothing Then
'name of userform .Show
End If
End If
End Sub
I was able to open the UserForm by clicking in the cell A1, but not by clicking in any cell inside the column A.
I tried to solve this problem with this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
Dim check As Boolean
check = True
If check Then
Dim i As Long
For i = 1 To 100000
If Not Intersect(Target, Range("A" & i)) Is Nothing Then
UserForm1.Show
check = False
End If
Next
End If
End If
End Sub
It actually works fine, but it is very slow, is there any better possibility to solve this?
To display the form when a cell is selected in column A:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' if target is one cell and in column A
If Target.Columns.count = 1 And Target.Rows.count = 1 And Target.Column = 1 Then
UserForm1.Show
End If
End Sub
You can use .count and .column property together with AND and it will become so much simple and fast. Following code triggers pop-up if u click in column A on active-sheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo errorhandler
If Target.Count = 1 And Target.Column = 1 Then '.count to check if only one cell is selected and .column to check if it is a first column
'UserForm1.Show
'Do whatever you want to do here like opening User form
MsgBox "You clicked in column A"
End If
errorhandler:
End Sub

Program excel to return a specific value

I have a spreadsheet that is going to be used in a survey.
How can I make the cells only to return "x" regardless of what the survey taker type in.
For instance, if I write a "w" in the cell, it should turn into an "x".
I have come to a point where I think there is an option when I protect the workbook or sheet. Because I can tell from another spreadsheet (which has this function) that it only works if the workbook is protected.
I tried to google it, but it seems as if I don't know the right keywords to find the answer.
Also, I have found a set of Vba code that I fiddle with, but I'm not sure this is correct. I don't want to attach the code as I don't want to confuse any response here.
Thank you for any help provided.
Put this code in the worksheet module and test it out, when you change a cell in column A (1) it will activate,
Where is the worksheet Module?
Copy and paste the code ,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("A1,B1,C1,A4,B4,C4")) Is Nothing Then Exit Sub
Application.EnableEvents = 0
If Target <> "" Then Target = "X"
Application.EnableEvents = 1
End Sub
This should work for you (just change the range to the one you need) :
Option Explicit
Sub worksheet_Change(ByVal Target As Range)
On Error GoTo errorbutler 'error handler - important to have this in case your macro does a booboo
Application.Calculation = xlCalculationManual 'turn off automatic calculation to speed up the macro
Application.EnableEvents = False 'turn off events in order to prevent an endless loop
Dim LR, cell As Range 'Declare your variables
Set LR = Range("A1:b3") ' Select range of cells this macro would apply to
For Each cell In Target 'Loops through the cells that user have changed
If Union(cell, LR).Address = LR.Address Then 'Checks if the changed cell is part of your range
cell.Value="x" 'changes the value of that cell to x
End if
Next cell
Errorexit: 'part of error handling procedure
Application.EnableEvents = True 'Turn autocalc back on
Application.Calculation = xlCalculationAutomatic 'turn events back on
Exit Sub
Errorbutler: 'error handling procedure
Debug.Print Err.Number & vbNewLine & Err.Description
Resume Errorexit
End Sub
Oh yes, and this code should be put into the worksheet module - the same way as Dave has shown you

VBA Excel 2003 protect cells onclick

I have a spreadsheet which has a column on it (say column A). The idea is this column is populated by a user with various scores. Once the user is happy with their answers in column A, I want them to confirm that the answers are correct (ideally by clicking a button). Once that button is clicked, I want to use VBA to protect column A against being edited again. I'd rather not use the protect worksheet option, as there is additional data in the spreadsheet where I need to keep some cells locked but editable (they use data validation lists).
I did find this bit of VBA but this is based on worksheet change - if I could somehow use this but only have it activate once the user has confirmed the data is set, that would be ideal:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("A2:A14")) Is Nothing Then Exit Sub
Application.EnableEvents = False
MsgBox "Hey, leave me alone!", 48, "Sorry, I'm protected."
Application.Undo
Application.EnableEvents = True
End Sub
If what you posted suits your needs then:
In a module, something like this:
Public active As Boolean
Sub Button1_Click()
active = True
End Sub
And within your spreadsheet code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If active Then
If Intersect(Target, Range("A2:A14")) Is Nothing Then Exit Sub
Application.EnableEvents = False
MsgBox "Hey, leave me alone!", 48, "Sorry, I'm protected."
Application.Undo
Application.EnableEvents = True
End If
End Sub
A likely better solution would be to designate a cell within your sheet that the button populates, so the code would actually be something like:
If Range("A1") = "Locked" then
....