I want to know my error in my VBA code in my Excel and want some cells to be blocked if a another cell value is true.
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Cells(35, "CD").Value = True Then
ActiveSheet.Range("R29:AA38").Locked = True
Else
ActiveSheet.Range("R29:AA38").Locked = False
End If
End Sub
can you help me with that please!
Try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Set Ws = Target.Worksheet
Ws.Unprotect "pw" ' change to your password
If CBool(Ws.Cells(35, "CD")) = True Then
If MsgBox("Do you want to Lock the cells", vbYesNo) = vbYes Then
Ws.Range("R29:AA38").Locked = True
else
Ws.Range("R29:AA38").Locked = False ' delete this line if you don't need it
Application.EnableEvents = False
Ws.Range("R29:AA38").ClearContents
Application.EnableEvents = True
end if
else
Ws.Range("R29:AA38").Locked = False
end if
Ws.Protect "pw" ' change to your password
End Sub
Related
Sub Macro3()
'
'
Const MySecretPassword = "Hello"
If ActiveSheet.Range("J49") Is Nothing Then Exit Sub
On Error GoTo Protect
If ActiveSheet.Range(J49).Value = "Password" Then
ActiveSheet.Range("A1:R37").Locked = True
Else
ActiveSheet.Range("A1:R37").Locked = False
End If
Protect:
ActiveSheet.Protect MySecretPassword
End Sub
I also tried:
Sub Macro4()
'
' Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Target = Range("J49") Then
If ActiveSheet.Target.Value = "Password" Then
ActiveSheet.Unprotect Password = "Hello"
Else
ActiveSheet.Protect Password = "Hello", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub
and
Sub Macro5()
'
' Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("J49") Is Nothing Then
ActiveSheet.Unprotect
If Target.Value = "Pascal" Then
Target.Offset(0, 1).Locked = False
Else
Target.Offset(0, 1).Locked = True
End If
ActiveSheet.Protect
End If
'
'
End Sub
I'm trying to make an Excelfile with different sheets, in which I want to lock a certain range of cells when Cell J49 is filled with Password. I have browsed the forum to see solutions, but I'm struggling to get it to work. 1 person can be in charge for this file, that's why I really want the password protection. Can anyone point my mistake out?
Try something like that
Sub pass_test()
sheet_password = "secret"
range_password = "Pascal"
target_value = ActiveSheet.Range("J49").Value
target_address = "A1:B2"
If target_value <> "" Then
ActiveSheet.Unprotect Password:=sheet_password
If target_value = range_password Then
ActiveSheet.Range(target_address).Locked = False
Else
ActiveSheet.Range(target_address).Locked = True
End If
ActiveSheet.Protect Password:=sheet_password
End If
End Sub
what is wrong with this code?
Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty(Sheet5.Range("A26").Value) = True Then
Sheet5.Rows("26:27").EntireRow.Hidden = True
ElseIf IsEmpty(Sheet5.Range("A26").Value) = False Then
Sheet5.Rows("26:27").EntireRow.Hidden = False
End If
End Sub
Can you please try it?
If IsEmpty(Worksheets("Sheet5").Range("A26").Value) = True Then
Worksheets("Sheet5").Rows("26:27").EntireRow.Hidden = True
ElseIf IsEmpty(Worksheets("Sheet5").Range("A26").Value) = False Then
Worksheets("Sheet5").Rows("26:27").EntireRow.Hidden = False
End If
Useful link:
https://learn.microsoft.com/en-us/office/vba/api/excel.range(object)
I found an answer!
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
If Sheet5.Range("A26").Value = "" Then
Sheet5.Rows("26:27").EntireRow.Hidden = True
Else
Sheet5.Rows("26:27").EntireRow.Hidden = False
End If
End Sub
Application.EnableEvents = True
I had to change
Private Sub Worksheet_Change(ByVal Target As Range)
to
Private Sub Worksheet_Calculate()
I needed to use calculate because the "" is created by formula therefore a calculation.
I get the run time error when I open the workbook. The open function works great without the close function, but as soon as I add the close function I get the error. Any suggestions?
Private Sub Workbook_Open()
Application.ScreenUpdating = False
For Each cell In Range("A1:Z1")
If cell.Value = "X" Then
cell.EntireColumn.Hidden = True
Else
cell.EntireColumn.Hidden = False
End If
Next cell
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Protect "1962"
Next ws
ThisWorkbook.Protect "1962", True
ThisWorkbook.Save
End Sub
The error occurs because you protect the worksheet in the BeforeClose routine. Hence the Workbook_Open doesn't have access to update it the next time it is being opened. Try this:
Private Sub Workbook_Open()
Dim cell As Range
Application.ScreenUpdating = False
ActiveSheet.Unprotect "1962" '<<<<
For Each cell In Range("A1:Z1")
If cell.Value = "X" Then
cell.EntireColumn.Hidden = True
Else
cell.EntireColumn.Hidden = False
End If
Next cell
ActiveSheet.Protect "1962" '<<<<
End Sub
I have a drop down list that has values "yes"/"no" (cell F 20) and button in the next cell ( cell G 20).
If user, selects "yes", button will be visible which he could click to add "Sheets"
If he selects "no", button will be hidden.
My question : I have write a code that will throw a warning if user has selected "yes" and not added new sheet and it should revert the value from drop down to "no" in this case.
I am not sure, what to include in my code that will serve my purpose?
Code on worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim str1 As String
ThisWorkbook.Unprotect Password:="xyz"
If Target.Address = "$F$20" Then
Select Case UCase(Target)
Case Is = "YES": Shapes("Button 8").Visible = msoTrue
Case Is = "NO": Shapes("Button 8").Visible = msoFalse
Code on Module (Button)
Sub insertSheet()
Application.ScreenUpdating = False
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim ws As Worksheet
worksh = Application.Sheets.Count
worksheetexists = False
ThisWorkbook.Unprotect Password:="xyz"
For x = 1 To worksh
If Worksheets(x).Name = "Sheet" Then
worksheetexists = True
MsgBox "Sheet Already Exists"
'Debug.Print worksheetexists
Exit For
End If
Next x
If worksheetexists = False Then
Sheets("BrownSheet").Visible = True
ActiveWorkbook.Sheets("BrownSheet").Copy _
After:=ActiveWorkbook.Sheets("BrownSheet")
Sheets("BrownSheet").Visible = False
ActiveSheet.Name = "Sheet"
ActiveSheet.Protect Password:="xyz", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ThisWorkbook.Protect Password:="xyz"
End Sub
Please help!!
Thanks
Place this code in the ThisWorkbook module and make the necessary changes to the sheet names.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Worksheets("mySheet").Range("F20").Value = "Yes" Then
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Sheet" Then
Dim bOk As Boolean
bOk = True
Exit For
End If
Next
End If
If Not bOk Then
MsgBox "Please add the sheet before saving!"
Cancel = True
End If
End Sub
For more on Before Save see MSDN Article
I have a spreadsheet that is edited by multiple users. To prevent tampering with previous data the cells are locked once data has been entered and the file saved. I have a few small bugs in the code though:
Even if the user has saved manually and then exits the application they are still prompted to save again.
The cells should be locked after a save when the application is running and not just when it is exited. Previously I had this code in the before_save event but the cells were being locked even if a save_as event was cancelled so I removed the code for now. Fixed
(Edit: I've just realised how obvious this error was. I even said it in this statement! Trying to lock cells after a save event using a before save event sub! )
Code
With ActiveSheet
.Unprotect Password:="oVc0obr02WpXeZGy"
.Cells.Locked = False
For Each Cell In ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:="oVc0obr02WpXeZGy"
End With
The workbook open, hide all sheets and show all sheets subs are used to force the end user into enabling macros. Here is the full code:
Option Explicit
Const WelcomePage = "Macros"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim wsActive As Worksheet
Dim vFilename As Variant
Dim bSaved As Boolean
'Turn off screen updating
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Record active worksheet
Set wsActive = ActiveSheet
'Prompt for Save As
If SaveAsUI = True Then
vFilename = Application.GetSaveAsFilename("", fileFilter:="Excel Files (*.xls), *.xls")
If CStr(vFilename) = "False" Then
bSaved = False
Else
'Save the workbook using the supplied filename
Call HideAllSheets
ThisWorkbook.SaveAs vFilename
Application.RecentFiles.Add vFilename
Call ShowAllSheets
bSaved = True
End If
Else
'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True
End If
'Restore file to where user was
wsActive.Activate
'Restore screen updates
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Set application states appropriately
If bSaved Then
ThisWorkbook.Saved = True
Cancel = True
Else
Cancel = True
End If
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
Private Sub HideAllSheets()
Dim ws As Worksheet
Worksheets(WelcomePage).Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws
Worksheets(WelcomePage).Activate
End Sub
Private Sub ShowAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
'Lock Cells upon exit save if data has been entered
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Cell As Range
With ActiveSheet
.Unprotect Password:="oVc0obr02WpXeZGy"
.Cells.Locked = False
For Each Cell In ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:="oVc0obr02WpXeZGy"
End With
End Sub
Thanks :)
It is asking for them to save before exiting even though they have already saved because of these lines:
'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True
You are changing the worksheet after saving it (by calling ShowAllSheets) so it does need to be saved again. The same is true of the saveAs code.
I fixed the second problem by using another IF. This ensures the cells are only locked if the data is saved:
'Lock Cells before save if data has been entered
Dim rpcell As Range
With ActiveSheet
If bSaved = True Then
.Unprotect Password:="oVc0obr02WpXeZGy"
.Cells.Locked = False
For Each rpcell In ActiveSheet.UsedRange
If rpcell.Value = "" Then
rpcell.Locked = False
Else
rpcell.Locked = True
End If
Next rpcell
.Protect Password:="oVc0obr02WpXeZGy"
Else
MsgBox "The LogBook was not saved. You are free to edit the RP Log again", vbOKOnly, "LogBook Not Saved"
End If
End With