When you enter a value the cell should be locked. Just the yellow cells should be able to lock. But always when I enter something in the cell i get this error code:
The error in the code:
Full code:
Private Sub Worksheet_Change(ByVal Target As Range)
Sheet1.Unprotect "1234"
If VBA.IsEmpty(Target.Value) Then
Target.Locked = False
Else
Target.Locked = True
End If
Sheet1.Protect "1234"
End Sub
table:
I suspect the reason you are getting the error is you do not have a sheet called Sheet1. You may have renamed or deleted the first sheet at some point.
To call a Worksheet dynamically from a range you can use Range.Worksheet. This will give you the worksheet of the range you are using.
Here is a way to use it in your scenario:
First it requires a bit of Prep
Select All cells in worksheet
Right Click --> Format Cells
Protection Tab
Uncheck Locked. (This means no cell on the sheet is locked)
When a cell is edited if it was yellow and has a value in it, it will locked. Then all the cells on that worksheet will be locked if they were set to be locked.
Private Sub Worksheet_Change(ByVal Target As Range)
' Only deal with one Cell.
If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
'Target background is Yellow (You may have to modify the code to the RGB value of your yellow) and value is Empty
If Target.Interior.Color = RGB(255, 255, 102) And Target.Value <> "" Then
Target.Worksheet.Unprotect "1234"
Target.Locked = True
Target.Worksheet.Protect Password:="1234", Contents:=True
End If
End If
End Sub
Related
I want to lock the cell after entering a value in it. When I change the value on sheet2 A1, the value should still be locked in B2.
When I enter "3" in Sheet2 A1 the number 2 should till be there.
Here the code I already have:
Private Sub Worksheet_Change(ByVal Target As Range)
Sheet1.Unprotect "1234"
If VBA.IsEmpty(Target.Value) Then
Target.Locked = False
Else
Target.Locked = True
End If
Sheet1.Protect "1234"
End Sub
My first answer was assuming that cell Locking referred to the Range.Locked property but now I understand that was intended to refer to the cell values and preventing them from recalculating.
There are a few techniques that can be used to prevent cells from recalculating. The easiest would be to just change any formulas into a static value like:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target.Value = Target.Value
Application.EnableEvents = True
End Sub
This event will get rid of every formula after it calculates its value the first time. Every cell will just be whatever value the user enters or whatever value the formula calculates the first time.
You can limit the range that the event will operate within by using Intersect like:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OperationalArea As Range, AffectedArea As Range
Set OperationalArea = Me.Range("B2:F10")
Set AffectedArea = Intersect(Target, OperationalArea)
If Not AffectedArea Is Nothing Then
Application.EnableEvents = False
AffectedArea.Value = AffectedArea.Value
Application.EnableEvents = True
End If
End Sub
This would limit the event to only change cells within the area "B2:F10" as defined in OperationalArea.
If you don't like this idea you can try messing about with Application.Calculation but it gets very messy when you have multiple sheets or workbooks open.
When you do Worksheet.Protect, every cell is locked by default. You need to specify which cells should still be editable (not locked) after protecting the sheet. In your case, you need to specify that every cell except your chosen few are not locked.
The second important note is that Worksheet.Protect has an option UserInterfaceOnly which when true, allows macros to continue editing cells without needing to unprotect the sheet first. This means you can leave the sheet protected and just unlock or lock cells as needed.
Here is an example of how to unlock every cell except A1 on Sheet1:
Sub Example()
With Sheet1
.Protect Password:="1234", UserInterfaceOnly:=True
.Cells.Locked = False
.Cells(1, 1).Locked = True
End With
End Sub
In my worksheet, I have locked whole sheet, with password, with not locked range.
Not locked range is =A14:H50 and I want to make range =C14:C50 become dynamically locked range based on BX value. Eg. If B14 value locked, C14 should be locked. If B14 value notlocked, C14 shouldn't be locked.
There are many codes for dynamically locked cells, but I don't know how it works if whole sheet without range is locked also.
Please, copy the next event code in the sheet code module. The code as it is, protect and unprotect without a password. If your sheet is protected with a password, please change the line pass = "" in pass = "myPassword":
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B14:B50")) Is Nothing Then
Dim pass As String
pass = "" 'set the password. Otherwise, protection/unprotection is done without a pass
If Target.Cells.Count > 1 Then Exit Sub
ActiveSheet.Unprotect pass
If Target.Value = "locked" Then
Target.Offset(0, 1).Locked = True
ElseIf Target.Value = "notlocked" Then
Target.Offset(0, 1).Locked = True
End If
ActiveSheet.Protect pass
End If
End Sub
What should i do to dynamically lock/unlock my cell in excel? For example, if i create a new document, by default all cells are unlock but i entered a data on that cell it will be lock. I tried this, which i found here Lock empty cells and unlock free cells
Sub test()
Dim rngTemp As Range
For Each rngTemp In Range("A1:XFD1048576").Cells
With rngTemp
If .Value > 0 Or Len(.Value) > 0 Then
.Locked = False
End If
End With
Next
End Sub
but it's not working on my case. I am using 2007 excel version. Do i still need to save the code or Alt + Q is enough?
EDIT: As per #JvdV's answer I tried the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
With Sheet1
.Unprotect
.Cells.Locked = True
.Cells.SpecialCells(xlCellTypeBlanks).Locked = False
.Protect
End With
End Sub
But this returns an error Run-time error '1004' No cells were found on .Cells.SpecialCells(xlCellTypeBlanks).Locked = False.
If you really are intested in those cells, you can simply refer to a worksheet's cells. Also, no need to loop through those cells individually, for example:
Sub test()
Dim rng As Range
With Sheet1 'Change according to your sheet's CodeName
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeBlanks).Locked = True
.Protect
End With
End Sub
Where .Cells.Locked = False unlocks all cells and .Cells.SpecialCells(xlCellTypeBlanks).Locked = True locks all cells blank cells (Note: a ="" value through formulas is considered a value and will stay unlocked)
Both Unprotect and Protect are needed to have full effect of your changes.
If this is code you want to run each time a value is changed, you'll have to look into the Worksheet_Change event. And if your goal is to have empty cells unlocked and cells that contain a value locked, just swap around the True and False.
EDIT (as per your comments)
If this is something you like to run on every next selection of cells, try the following (error handler included since you not using the whole worksheet nomore)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheet1.Unprotect 'Change according to your sheet's CodeName
With Target
.Cells.Locked = True
On Error Resume Next
.Cells.SpecialCells(xlCellTypeBlanks).Locked = False
On Error GoTo 0
End With
Sheet1.Protect
End Sub
If you looking for an alternative where you loop through your target range, you can implement the suggestion by #M.Schalk
As an addition to the (correct) answer above, here is my suggestion for a Worksheet_Change event, as you requested in the comments. This will have to be placed in the workbook-specific code module:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cll As Range
On Error Resume Next
For Each cll In Target.Cells
With cll
If .Value2 <> vbNullString Then
.Locked = True
Else
.Locked = False
End If
End With
Next
End Sub
It's important to note, that (at least in my version of Excel) the .Locked property of a cell only has an effect when the sheet is protected. To change the value of the .Locked property however, the sheet must not be protected. To incorporate this you might want to use something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cll As Range
On Error GoTo Handler
Me.Unprotect
For Each cll In Target.Cells
With cll
If .Value2 <> vbNullString Then
MsgBox cll.Value2
.Locked = True
Else
MsgBox "NullString"
.Locked = False
End If
End With
Next
Handler:
Me.Protect
End Sub
This will lead to every cell becoming un-changeable once a value is entered, while still letting the user enter values in all empty cells. To change existing values you will need to manually unprotect the sheet. You might use something like the code provided in the answer above to restore a desired state after the sheet was unprotected and changed.
I have this function where anytime a cell inside the specific range changes, calls a function.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
Call fit_text
End If
End Sub
The function fit_text changes the font size of the value of the active cell.
Sub fit_text()
MsgBox ActiveCell.Characters.Count
If ActiveCell.Characters.Count > 100 Then
ActiveCell.Font.Size = 8
Else
ActiveCell.Font.Size = 10
End If
End Sub
PROBLEM: whenever I change the value of a cell where the character count is bigger then 100, the font size remains 10 and the message box that tells the value of the count shows 0, but whenever I run it on vba the message box shows the correct value and changes the font size if the count is bigger then 100. I need it to be automatic. Can´t change the height or the width of the cells
Note that Excel can automatically shrink the font size to fit into the cell. Therefore select your cell, press Ctrl+1 go to the Alignment tab and select Shrink To Fit.
To fix your code:
Don't use ActiveCell. Use Target or the Intersect range instead. The ActiveCell might not be the cell that was changed. And also Target can be multiple cells so you need to loop through all the changed cells and test each cell individually.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Target.Parent.Range("A1:L60"))
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange 'loop through all changed cells
MsgBox Len(Cell.Value)
If Len(Cell.Value) > 100 Then
Cell.Font.Size = 8
Else
Cell.Font.Size = 10
End If
Next Cell
End If
End Sub
ActiveCell is the one active after the Change event. You can pass Target from the event to your method fit_text, so that it will always refer to the changed cells:
Private Sub Worksheet_Change(ByVal target As Range)
If Not Intersect(target, Range("A1:L60")) Is Nothing Then
Call fit_text(target)
End If
End Sub
Sub fit_text(target As Range)
MsgBox ActiveCell.Address(False, False)
MsgBox target.Characters.Count
' If ActiveCell.Characters.Count > 100 Then
' ActiveCell.Font.Size = 8
' Else
' ActiveCell.Font.Size = 10
' End If
If target.Characters.Count > 100 Then
target.Font.Size = 8
Else
target.Font.Size = 10
End If
End Sub
You will also want to include a check for when Target is more than a single cell; in which case you will probably want your procedure to check each cell's content.
The problem is the 'ActiveCell'.
For example when you edit the Cell A1 and press enter, the ActiveCell you are using in fit_text is not A1, but A2.
This however can easily fixed, by just passing the Cell from the Worksheet_Change to fit_text.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
'Pass the Target to 'fit_text'
Call fit_text(Target)
End If
End Sub
Sub fit_text(Cell)
'Instead of using ActiveCell, use Cell (which is the passed Target)
MsgBox Cell.Characters.Count
If Cell.Characters.Count > 100 Then
Cell.Font.Size = 8
Else
Cell.Font.Size = 10
End If
End Sub
I found the code below, and while it highlights the entire row it also removes the color from any previously colored cell.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Target.Parent.Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire row and column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
I would like to highlight the entire row on selection of a cell (that may already be colored), but when I move to a cell in a different row, the previously highlighted row should return to its previous color.
Is there a way to modify the previously selected cells/rows?
Conditional formatting overrides "regular" formatting (without replacing it), so if you don't already have some CF applied it's a convenient way to highlight a row without zapping any existing cell colors.
Here's a very basic example:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Me.Cells.FormatConditions.Delete
With Target.EntireRow.FormatConditions.Add(Type:=xlExpression, _
Formula1:="=TRUE")
.SetFirstPriority
.Interior.Color = 65535
End With
Application.ScreenUpdating = True
End Sub
You will need to store the format and row number somewhere then paste it back upon selecting a new row.
This will store the exiting format and row number before the highlight to the 1,040,000 row on the same sheet.
Then when another row is selected it will check if there is formatting there and replace the row from where it was copied back.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
'test if formatting exist and copy it back to the row just left.
If Cells(1040000, 1) <> "" Then
Rows(1040000).Copy
Rows(Cells(1040000, 1).Value).PasteSpecial Paste:=xlPasteFormats
End If
'Copy formating to store
Rows(Target.Row).Copy
Rows(1040000).PasteSpecial Paste:=xlPasteFormats
Cells(1040000, 1) = Target.Row
With Target
' Highlight the entire row and column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I have created an add-in for this. Download, enable content, and click the install button. The add-in creates three buttons on the View ribbon tab that toggle the highlighting.
Uses Conditional Formatting, so no overriding cell color settings.
All code is in the add-in, so no additional VBA required.
This is what I can come up with:
Public rngPreviousColor As Range
Public lngColor As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not rngPreviousColor Is Nothing Then
rngPreviousColor.Interior.ColorIndex = lngColor
End If
Set rngPreviousColor = Target.EntireRow
lngColor = rngPreviousColor.Interior.ColorIndex
With Target
.EntireRow.Interior.ColorIndex = 8
End With
End Sub
The idea is that the other row is the whole in one color and we save the row as a range rngPreviousColor and the color as lngColor.