How do I render any cell in range ("A1:A10") uneditable (cannot be changed) if there is any content in 2 cells to the right (same row, column C), and make that cell editable again once the cell in same row column C becomes empty.
I tried the code below but it has no effect, i can still edit the cells in col A even with content in col C. Ideally I would like to have it done without protecting sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("C1:C10")) Is Nothing Then
If Target.Value <> "" Then
Target.Offset(0, -2).Cells.Locked = True
ActiveSheet.Protect Contents:=True
End If
Application.EnableEvents = True
End If
End Sub
Thank you,
Jay
Option Explicit
'*** Note: I need to reside in the Sheet Module for the
' sheet I am working on!
'*** Note: Make sure the Locked flags for A1:A10 and
' C1:C10 are cleared before implementing.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Application.EnableEvents = False 'Turn off Events to prevent loop!
If Not Intersect(Target, Range("C1:C10")) Is Nothing Then
ActiveSheet.Unprotect 'You need to unprotect before proceeding
For Each rng In Target
If rng <> "" Then 'Checking for Target.Address will always have a value!
rng.Offset(0, -2).Locked = True
Else
rng.Offset(0, -2).Locked = False
End If
Next rng
ActiveSheet.Protect Contents:=True 'Turn Protection back on
'*** If you have other protected elements DrawingObjects and/or Scenarios
' you need to include in line above.
End If
Application.EnableEvents = True 'Re-enable Events
End Sub 'Worksheet_Change
HTH
You are checking Target.Address on being an empty string. Why? Shouldn't that be Target.Value?
In top of this, what's going wrong? Did you debug the code, using breakpoints? What did you see? ... In case my answer does not satisfy your needs, please edit your question and add the needed information.
Related
This is a simple answer but one I cannot find.
I have two columns of data.
Column A (1) has yes/no data validation list options in every cell.
Column B also has data validation with say 6 strings of text options in every cell.
But I only want each the corresponding cell (column B) to update in the same row as column A
e.g A20 toggled, then B20 is updated. Like so
A20 is selected “Yes” from the dropdown option and B20 is updated with the string “complete” which is one of the states you can select in the dropdown boxes manually in every cell in column B.
I had some code but I would have to write an argument for every cell and then two macros for every yes / no.
This is code that works for one cell only but this is not ideal for many cells but it works
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A20")) Is Nothing Then
Select Case Range("A20")
Case "Yes": Macro_001
Case "No": Macro_002
End Select
End If
End Sub
Sub Macro_001()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("August 2020").Select
Sheets("August 2020").Range("B20").Select
ActiveCell.FormulaR1C1 = "Complete"
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Sub Macro_002()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("August 2020").Select
Sheets("August 2020").Range("B20").Select
ActiveCell.FormulaR1C1 = ""
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
There much be an easier way with .range perhaps
Thanks in advance
In the developer tab click view code, choose the sheet you want the macro to run on, make sure the upper left drop down says worksheet and the upper right says Change (I'll assume your sheet has headers):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ChangeCell As Range
Dim numrows As Long
numrows = Cells(Rows.Count, 1).End(xlUp).Row
Set TriggerCells = Range("A1")
Set KeyCells = Range("B2:B" & numrows)
If Application.Intersect(TriggerCells, Range("A1")) = "[Column Header Text]" Then
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If Target.Value = "Yes" Then
Range("B" & Target.Row).Value = "Completed"
End If
End If
End If
End Sub
Try that, see if it works for you.
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.
How to clear a cell based on a change of other cell but for every row separately?
Say, I change AI5 and it clears AQ5, I change AI17 it clears AQ17?
I've got this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("AI5")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("AQ5").ClearContents
Application.EnableEvents = True
End Sub
And it works only for the cells in the code.
If I change both to a range of the column, it clears all column AQ, which is not what I need.
Thanks
Like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("AI" & Target.Row)) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("AQ" & Target.Row).ClearContents
Application.EnableEvents = True
End Sub
You need to tell excel which row, and the row will be the same as the Target.Row so you can use that.
I have a working macro that hides/unhides specific columns based off specific values in Column B. I also want to add another trigger that takes the user to the most recently used row. Below is my attempt.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim t As Range
For Each t In Intersect(Target, Range("B:B"))
Select Case (t.Value)
Case "A"
Columns("B:BP").EntireColumn.Hidden = False
Columns("H:BL").EntireColumn.Hidden = True
Case "B"
Columns("B:BP").EntireColumn.Hidden = False
Columns("F:G").EntireColumn.Hidden = True
Columns("P:BP").EntireColumn.Hidden = True
End Select
Next t
End If
safe_exit:
Application.EnableEvents = True
'Go to last cell in column B
With ActiveSheet
Range("B5").Select
Selection.End(xlDown).Select
End With
End Sub
Perhaps I misread your question from the other answer - and if so, I will be more than happy to delete this one.
You can simply add a variable that will track this for you and persist as long as you keep Excel open.
Private lastUsedRng As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Set lastUsedRng = Target
. . .
...that takes the user to the most recently used row
You can accomplish this with
lastUsedRng.Select
Use Select as little as possible, and replace the last section starting with 'Go to last cell in column B with something like this, except moving it inside the If...End If.
With Me
.Cells(.Rows.Count, 2).End(xlUp).Select
End With
I have a table of values that I need to fill out through a worksheet change function.
What I am trying to do is change a cell in columns B-G, depending on where the target is.
Private Sub Worksheet_Change(ByVal Target As Range)
If (Not Intersect(Target, Range(Cells(12, 2), Cells(14, 7))) Is Nothing) Then
Cells(16,Application.WorksheetFunction.Column(Target))="Hello"
End If
End Sub
I have similar bits of code in the same worksheet_change sub that work fine when I use Target.Offset(1,0) but since my possible target range is in more than 1 Row, I don't know how to make it so that it is always row 16 and the same column as the target....
You need to deal with situations where Target is more than a single cell and disable event handling so when you change a value on the worksheet, the Worksheet_Change doesn't try to run on top of itself.
This will put 'hello' into the cell immediately to the right of any cell within B:G that changes; essentially you would be adding 'hello' to columns C:H on the associated row of each cell in Target.
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(target, Range(Cells(12, "B"), Cells(14, "G"))) is nothing then
on error goto safe_exit
application.enableevents = false
dim t as range
for each t in intersect(target, Range(Cells(12, "B"), Cells(14, "G")))
t.Offset(1,0) = "hello"
next t
End If
safe_exit:
application.enableevents = true
End Sub