How to make a specific cell in excel uneditable - vba

My problem is I'm trying to make a cell cannot be edited by the users after the inputs are given e.g. I want to let the user input something from cell C22-C28 then after the user inputs the cell, that specific cell shouldn't be edited. What should be the best solution for this? Any suggestions?

Take a look at this question
How to Lock the data in a cell in excel using vba
where are multiple nice answers. In basic, you need to set your range to .locked and then protect sheet via .protect, for more develop info try to look at msdn
Edit: so you can use this as mentioned in this question (Restricting the user to delete the cell contents)
Without lock and unlock, you can use this. We have there one global variable to store selection value (to preserve beforechange state). Function SelectionChange, updating value of current cell, so we can restore cell value after users try.
Sub worksheet_change just controling, if user targeting specified row and column (can be adjusted for whole range), and if he try to change value, he is prompted and value is set back.
Dim prevValue As Variant
Private Sub worksheet_SelectionChange(ByVal target As Range)
prevValue = target.Value
End Sub
Private Sub worksheet_change(ByVal target As Range)
If target.Row = 5 And target.Column = 5 Then
If target.Value <> prevValue Then
target.Value = prevValue
MsgBox "You are not allowed to edit!", vbCritical + vbOKOnly
End If
End If
End Sub

Maybe you can try the code below:
Option Explicit
Public OriginalCell As Range
Public ProtectedCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
lastRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
If Not Intersect(Target, Range("C1:D" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)) Is Nothing Then
Application.ScreenUpdating = False
Set ProtectedCell = Target
MsgBox "Access Denied", vbExclamation, "Access Status"
Cells(lastRow, 3).Select
Application.ScreenUpdating = True
End If
Hope it will help solve your problem.

Related

Display cell content in a text box in excel using VBA

I have a range of cells with data. I want a text box to show the cell content when I click on any cell in the text box. Is this possible? Thanks
You could just use something like this:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Rows
For i = 1 To lRow
If Cells(i, 1).Count = 1 Then
If Cells(i, 1) = "" Then
Else
If Not Intersect(Target, Cells(i, 1)) Is Nothing Then
MsgBox (i)
End If
End If
End If
Next i
End Sub
This will show the value in a message box, not a text box. Not sure why you need a text box.
i refers to the row and change the 1 in lRow = Cells(Rows.Count, 1).End(xlUp).Rows to the correct column number you are working in
Add this to the worksheet (see the black arrow):
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Target.Value
End Sub
In general, if you want to check for a specific range, you can define the range in the event:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngPreselected As Range
Set rngPreselected = Range("A1:B10")
If Not Intersect(Target, rngPreselected) Is Nothing Then
MsgBox Target.Value
End If
End Sub
In this case, A1:B10 is the defined range.
That's called Event. See more about events here: http://www.cpearson.com/excel/events.aspx

VBA define ranges and static date stamps

I need some help with this code as it doesn't work properly.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("W:W").Column Then
Cells(.Row, "AC").Value = Int(Now)
End If
End With
Next Cell
End Sub
I am trying to get automatic static date stamps in column "AC" every time I fill in cells in column "W" and I want to start with row "19".
Tried to use
If .Column = Range("W19").End(xldown) Then
but it doesn't work.
I've just started using macro and vba and it will really help me if you can explain any solutions to me.
Thank you
Always turn off events if you are going to write to the worksheet in order that the Worksheet_Change event macro does not try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("W:W")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("W:W"))
If rng.Row > 18 Then _
rng.Offset(0, 6) = Date 'or Now for datetime
Next rng
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should handle multiple changes to column W like a block range paste.

Prefill a certain cell with a number when data (a letter) is entered in one cell

I'm trying to figure out a VBA code that will allow me to prefill a certain cell with a number when I type in "X" in a cell right next to it. I can't figure out if I should use Range, or Insert, or what.
I cannot use a button and assign a macro to it because I need to see which cells I have put an "X" into.
This is what I have so far, but it's using a button with macro assigned to it:
490 is being entered into E9 and tabs over to F9 after the macro button is clicked:
Sub eightNineSpring()
Range("E9").Select
ActiveCell.FormulaR1C1 = "490"
Range("F9").Select
End Sub
as automation put in the worksheet you need it:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Count = 1 Then
If Target.Value = "x" Then Target.Offset(0, -1).Value = 490
End If
End Sub
or as formula in E1 then copy down
=IF(F1="x",490,"")
But keep in mind when deleting the "x" (or replace it with something different):
The function will empty the 490 again while the change event will not
When using a Change Events that makes a change, Application.Events should be turned off to avoid the code calling itself recursively.
The code below caters for one or more cells in E1:E10 being updated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("F1:F10"))
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng2 In Range
If rng2.Value = "x" Then rng2.Offset(0, -1).Value = 490
Next
Application.EnableEvents = True
End Sub

Protecting a Sheet - While allowing changes via a double click

I am creating a spreadsheet where people are to enter when something has been completed. I figured the most efficient way would be to use double click tick boxes. However, I want to pull the user ID and the timestamp for this, and don't want anyone to be able to edit anything except if they are double clicking something for the first time.
I have the below which works for what I need but I don't know how to protect the sheet exactly as I wish.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Target.Offset(0, 1).Value = Environ("UserName")
Target.Offset(0, 2).Value = Format(Now, "yyyy-mm-dd hh:mm:ss")
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Cancel = True
Exit Sub
End If
End Sub
Also, if I protect columns C and D then it won't let the macro enter the values needed there. I know I may need to protect the whole worksheet and have it unlock the cells upon a double click to allow the change to happen and then lock again straight after but I can't figure out how to manage that!
Any help is appreciated!
What you could do is protect the sheet as usual and put in the check-boxes. Then assign this macro to all the checkboxes -
Sub ChkBxClk()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
If shp.ControlFormat.Value = xlOff Then
MsgBox ("This was already checked off")
shp.ControlFormat.Value = xlOn
Exit Sub
End If
If shp.ControlFormat.Value = xlOn Then
ActiveSheet.Unprotect
Dim rng As Range
Set rng = Range(shp.TopLeftCell.Address)
rng.Offset(0, 1).value = Environ("UserName")
rng.Offset(0, 2).value = Format(Now, "yyyy-mm-dd hh:mm:ss")
ActiveSheet.Protect
End If
End Sub
Now, if a user checks a box (which is allowed on a protected sheet), it will unlock and allow you to enter what you want in the offset cells.

excel vba on cell change error

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Range = Range("A1") Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
that's the code however when i copy paste a set off cell, let's say 2 columns and 3 rows
it produce runtime error 13 type mismatch on line
If Target.Range = Range("A1") Then
why?
i simply wants the vba to do something everytime cell A1 changes
the value of A1 itself is an excel sum formula
You get type-missmatch error, becase you're trying to compare range (containing many cells) with single cell. If you want to do something every time cell A1 changed, use this one instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ErrHandler
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
ExitHere:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Resume ExitHere
End Sub
also note that I'm using Application.EnableEvents = False - it's a good habbit for Worksheet_Change event to use it. It prevents code from infinity firing itself each time you change any cell in event handler code.
UPD:
Btw, the value of A1 itself is an excel sum formula - you can't track changes of formula using above approach. I covered in details how you can do it in this question: Using Worksheet_Calculate event for tracking changes of formula
Simoco's answer should work for you. Another way (the one I usually use, though only out of habit) is to compare the addresses:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A1").Address Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
You are getting an error because Target.Range is not defined. You should either just refer to Target (a Range Object) or Target.Address (the address of the Range Object). Secondly, depending on the context, Range("A1") refers to either the cell A1 itself (a Range Object) or the value in cell A1 (a literal value). You need to carefully think what you want to compare to what.
If, as you said, you want the comparison done whenever the value in Range("A1") changes then you should follow Simoco's suggestion.