EXCEL VBA for locking cells in a range where offset cell -1 Column is Blank

Question

I need a piece of VBA coding to help me complete a project. My Knowledge of VBA is very basic so I am struggling. I give as much details as possible since I have read a similar request but still failed to complete the code.

I have a series of "two columns" (Pattern and Desks) (x7) representing the seven days of the week Sunday - Saturday. The left column for each day represents the shift pattern and the right column for each day represents the desk allocated to each person. There are some blank columns so I am working with name ranges.

The shift pattern columns x7 are is on the left and defined as a range named "Pattern". The desks columns are immediately to right of each shift column and are defined a range named Desks. The columns are about 25 cells. But this vary from workbook to workbook. Hence use of named range.

I want to lock each cell in the named range called "Desks" where the cell -1 column left in the name range "Pattern" is not populated .

The sheet has already been select and unprotected and the range called Desks unlocked.

Sheets("Assign Desks").Select
    ActiveSheet.Unprotect
    Application.Goto Reference:="Desks"
    Selection.ClearContents
 'Unlock Cells
    Selection.Locked = False

After the code to lock the cells the worksheet is protected the ribbon hidden and the screen split to show to worksheet. That is working fine.

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Other information The Pattern column contains a formula that displays the pattern when data is refreshed (pasted into another sheet of the workbook). Both columns contain conditional formatting to format the cells once populated.

Once refreshed the users needs to assign desks for each shift (this cannot be automated because human decision is required.) However I want the user to be able to tab through the cells where desks need to be assigned from the list of available remaining available desks. I want cells were there is no shift alongside to be skipped (therefore locked). Part of worksheet

barvobot barvobot · Accepted Answer · 2017-10-06T19:35:01

Would something like this do the trick? I don't like working with named ranges whenever possible. I couldn't see the rows/columns in the example so this method attempts to define them dynamically. It also turns locked cells yellow just so the user knows which ones are locked, but feel free to remove/change this as desired (obviously).

Option Explicit
Sub UnlockSomeCells()
Dim headerRow As Long, lastRow As Long, firstCol As Long, lastCol As Long
Dim x As Long, y As Long
Dim ws As Worksheet

'set the worksheet to work with
Set ws = ThisWorkbook.Sheets("Assign Desks")

'unlock sheet
ws.Unprotect

'define the row where the headers are located (change as necessary)
headerRow = 5

'determine the last column
lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column

'determine firstcol
For y = 1 To lastCol
    If ws.Cells(headerRow, y).Value <> "" Then
        firstCol = y
        Exit For
    End If
Next y

'lock all cells by default
ws.Cells.Locked = True

'loop through columns
For y = firstCol To lastCol

    'if finding the start of a set, start
    If ws.Cells(headerRow, y) = "Shift Pattern" Then

        'define last row for set
        lastRow = WorksheetFunction.Max( _
        ws.Cells(ws.Rows.Count, y + 0).End(xlUp).Row, _
        ws.Cells(ws.Rows.Count, y + 1).End(xlUp).Row, _
        ws.Cells(ws.Rows.Count, y + 2).End(xlUp).Row)

        'clear middle col
        'With ws.Range(ws.Cells(headerRow + 1, y + 1), ws.Cells(lastRow, y + 1))
        '    .ClearContents
        '    .Interior.ColorIndex = xlNone
        'End With

        'find cells to unlock
        For x = headerRow + 1 To lastRow
            If ws.Cells(x, y) <> "" Then

                'unlock the cell
                ws.Cells(x, y + 1).Locked = False

                'show that the cells are UNlocked in some way for the user's benefit
                'ws.Cells(x, y + 1).Interior.Color = RGB(0, 255, 255)

            End If
        Next x

    End If

Next y

'lock sheet
ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Edit: Changed to make all cells locked by default, and only unlock cells that are to the right of a non-blank entry in the Shift Pattern column.

EXCEL VBA for locking cells in a range where offset cell -1 Column is Blank

1 Answers