Hello everyone,
I had posted this before but my workbook has changed significantly since posting originally. I have been told re-post it. Because of security, I cannot use XL2BB so I will have to use images as well as the code I paste. I will try to be as thorough as I can because (I think at least) there is a lot going on already.
I have a workbook where I need to be able to lock a row of cells once the last entry in that row is made. The data entry order can vary (column J might be the last entry one time, column C might be the last next time. etc..) There are also two columns that may or may not have values entered. Those columns are I and K. Column K is only filled automatically if a certain value is entered in column J otherwise it is blank and locked. Column I may or may not have any entry. All the rest of the columns B-L will have an entry. Columns G and J have pull down menus. The date in column E is an automatic entry using VBA and is locked (code at the end of the post). Column H is locked (VBA) until the value in column G is entered. If the user removes the value in G the value in H is removed and the cell re-locked.
The rest of the VBA on the sheet is to pull data from a separate master file and insert / update the data list on sheet 1 for the drop down list in the cells in column J. There is also a button command to update the list
Here is the code I have so far.
This code is on or will be on every sheet except sheet 1
This code is in the This Workbook section for protection.
I posted all the code in the workbook just in case some of the new code will affect the old code. I know how much work this is and how hard it is. This is why i'm here. I had allot of help with this. Because I only know enough to do very minor things if I have something to copy and manipulate from.
Thank you so much in advance,
Jim Lemieux
I had posted this before but my workbook has changed significantly since posting originally. I have been told re-post it. Because of security, I cannot use XL2BB so I will have to use images as well as the code I paste. I will try to be as thorough as I can because (I think at least) there is a lot going on already.
I have a workbook where I need to be able to lock a row of cells once the last entry in that row is made. The data entry order can vary (column J might be the last entry one time, column C might be the last next time. etc..) There are also two columns that may or may not have values entered. Those columns are I and K. Column K is only filled automatically if a certain value is entered in column J otherwise it is blank and locked. Column I may or may not have any entry. All the rest of the columns B-L will have an entry. Columns G and J have pull down menus. The date in column E is an automatic entry using VBA and is locked (code at the end of the post). Column H is locked (VBA) until the value in column G is entered. If the user removes the value in G the value in H is removed and the cell re-locked.
The rest of the VBA on the sheet is to pull data from a separate master file and insert / update the data list on sheet 1 for the drop down list in the cells in column J. There is also a button command to update the list
Here is the code I have so far.
This code is on or will be on every sheet except sheet 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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range
Set r = Range("G6:G5000")
Set r = Intersect(Target, r)
If Not r Is Nothing Then
Application.EnableEvents = False
For Each c In r
Select Case True
Case 7 = c.Column 'G
If c.Value = "" Then
Cells(c.Row, "H").Value = ""
Cells(c.Row, "H").Locked = True
Else
Cells(c.Row, "H").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
Application.EnableEvents = True
End Sub
This code is in the This Workbook section for protection.
VBA Code:
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
' UserInterfaceOnly:=True allows code to change data.
ws.Protect "exceler8", UserInterfaceOnly:=True, DrawingObjects:=True, _
Contents:=True, Scenarios:=True, AllowFiltering:=True
Next ws
End Sub
I posted all the code in the workbook just in case some of the new code will affect the old code. I know how much work this is and how hard it is. This is why i'm here. I had allot of help with this. Because I only know enough to do very minor things if I have something to copy and manipulate from.
Thank you so much in advance,
Jim Lemieux