I wish I didn't have to rely so much on others for help. Fortunately the people here have been great with helping me with this. Now, I need help to make sure users work on a workbook one row at a time. I only want the row in use (active row) to be unlocked. The rows below the active row need to be locked, and the finished rows locked. The workbook already has allot of code already done. I may be long winded, but I will try to be thorough.
There is a module (Module 1) that on start-up extracts data from a closed workbook. Each worksheet also has an update button (active-x) linked to this module.
In the "This workbook" section the code protects the workbook and enables Module 1 to extract data from an external workbook on open.
The sheets have code to protect individual cells, automatically add dates, and lock the active row when the required data is entered. There is also code for an active-x button that can manually update the sheet with the code used in Module 1.
The plan is to lock everything below the active row. Once the cell that now locks the active row is enabled, it not only locks the active row, it unlocks the required cells in the next row. It must only unlock columns B,C,D,F,G,I,J,K, L,M,N and O.
Columns B,C,D,F,I,J,L,M, and O are manual entries. Columns G,K and N have pull-downs. Columns E,H, and P are auto filled and always locked.
Here is all the code in the project. I don't know if you need it but here it is anyway.
This is the code in the "Thisworkbook" section
This is in Module 1
This code is in all the sheets in the workbook. All the sheets are the same except sheet 1. Sheets 2 and on are what I need to fix.
I hope this is not a monumental task, and someone is up to the challenge.
Thank you so much in advance,
Jim
There is a module (Module 1) that on start-up extracts data from a closed workbook. Each worksheet also has an update button (active-x) linked to this module.
In the "This workbook" section the code protects the workbook and enables Module 1 to extract data from an external workbook on open.
The sheets have code to protect individual cells, automatically add dates, and lock the active row when the required data is entered. There is also code for an active-x button that can manually update the sheet with the code used in Module 1.
The plan is to lock everything below the active row. Once the cell that now locks the active row is enabled, it not only locks the active row, it unlocks the required cells in the next row. It must only unlock columns B,C,D,F,G,I,J,K, L,M,N and O.
Columns B,C,D,F,I,J,L,M, and O are manual entries. Columns G,K and N have pull-downs. Columns E,H, and P are auto filled and always locked.
Here is all the code in the project. I don't know if you need it but here it is anyway.
This is the code in the "Thisworkbook" section
VBA Code:
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
' UserInterfaceOnly:=True allows code to change data.
ws.Protect "password", UserInterfaceOnly:=True, DrawingObjects:=True, _
Contents:=True, Scenarios:=True, AllowFiltering:=True
Next ws
UpdateDataFromMasterFile
End SubThis is in Module 1
VBA Code:
Sub UpdateDataFromMasterFile()
Dim wbMaster As Workbook
Dim wbMinion As Workbook
Dim wsMaster As Worksheet
Dim wsMinion As Worksheet
Dim noRows&
Dim i&
Dim arrMaster()
Dim arrMinion()
On Error GoTo ErrorHandler
Const wbMasterFileDir$ = "S:\Radiology\FLUORO LOG BOOKS\Approved Fluoroscopy List.xlsm"
If Not (Len(Dir(wbMasterFileDir)) > 0) Then
MsgBox "Provided master file directory does not exist!" & vbNewLine & _
"Path: " & wbMasterFileDir, vbCritical, "InfoLog"
Exit Sub
End If
Application.ScreenUpdating = False
Set wbMinion = ThisWorkbook
Set wsMinion = wbMinion.Sheets(1)
Set wbMaster = Workbooks.Open(wbMasterFileDir) 'GetObject(wbMasterFileDir)
Set wsMaster = wbMaster.Sheets(1)
With wsMaster
noRows = .Range("A" & Cells.Rows.Count).End(xlUp).Row
If noRows = 1 Then
Application.ScreenUpdating = True
MsgBox "There's no data to pull from Master File!", vbExclamation, "InfoLog"
Exit Sub
End If
arrMaster = .Range("A2:A" & noRows)
WbMasterClose wb:=wbMaster
arrMinion = wsMinion.Range("A2:A" & noRows)
End With
For i = 1 To UBound(arrMaster, 1)
arrMinion(i, 1) = arrMaster(i, 1)
Next i
wsMinion.Range("A2:A" & noRows) = arrMinion
MsgBox "Update completed.", vbInformation, "InfoLog"
DataClearance:
Application.ScreenUpdating = True
Set wbMinion = Nothing
Set wsMinion = Nothing
Set wbMaster = Nothing
Set wbMinion = Nothing
Exit Sub
ErrorHandler:
MsgBox "Unexpected error occured!", vbCritical, "InfoLog"
Resume DataClearance
End Sub
Private Sub WbMasterClose(wb As Workbook)
On Error Resume Next
Application.DisplayAlerts = False
wb.Saved = False
wb.Close
Application.DisplayAlerts = True
End Sub
Private Sub CommandButton1_Click()
UpdateDataFromMasterFile
End Sub
VBA Code:
Private Sub CommandButton1_Click()
UpdateDataFromMasterFile
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range
Set r = Union(Range("K6:K5000"), Range("N6:N5000"))
Set r = Intersect(Target, r)
If Not r Is Nothing Then
Application.EnableEvents = False
For Each c In r
Select Case True
Case 11 = c.Column 'K
If c.Value = "" Then
Cells(c.Row, "L").Value = ""
Cells(c.Row, "L").Locked = True
Else
Cells(c.Row, "L").Locked = False
End If
Case 14 = c.Column 'N
If c.Value = "" Then
Cells(c.Row, "O").Value = ""
Cells(c.Row, "O").Locked = True
Else
Cells(c.Row, "O").Locked = False
End If
Case Else
End Select
Next c
End If
If Target.Cells.Count > 4 Then Exit Sub
If Not Intersect(Target, Range("B6:B5000")) Is Nothing Then
With Target(1, 4)
.Value = Date
.EntireColumn.AutoFit
End With
End If
Dim p As Range
Set p = Range("L6:L5000")
Set p = Intersect(Target, p)
For Each p In Target
Select Case True
Case 12 = p.Column 'L
If p.Value <> "" Then
Check = MsgBox("Are your entries correct?" & vbCrLf & "After entering yes, These values CANNOT be changed.", vbYesNo + vbQuestion, "Cell Lock Notification")
If Check = vbYes Then
Target.Rows.EntireRow.Locked = True
Else
Cells(p.Row, "L").Value = ""
End If
End If
Case Else
End Select
Next p
Application.EnableEvents = True
End SubI hope this is not a monumental task, and someone is up to the challenge.
Thank you so much in advance,
Jim
