CODEWITHSUNDEEP
vbaexcel
Batteredburrito
Batteredburrito

Reputation: 589

Excel VBA: Locking range of cells

Im trying to lock a few ranges of cells to prevent them from being altered outside of the button press. I have the following code so far:

Private Sub DateRangePayer()

Dim unionRange As Range, uRng As Range, EssentialWrite As Range, chCell As Range, chRng As Range
Dim d As Long, k As Long, x As Long

ActiveSheet.Unprotect

Set EssentialWrite = Sheets("Essential Info").Range("E2:E6")
Set unionRange = ActiveSheet.Range("Q8:R12, T8:T12, Q16:R20, T16:T20")
Set chRng = ActiveSheet.Range("Q8:R12, T8:T12, Q16:R20, T16:T20")

x = Sheets("Essential Info").Range("G19").Value
ReDim OArr(1 To 5, 1 To 1) As Variant

For d = DateSerial(Year(x), Month(x), 1) To DateSerial(Year(x), Month(x) + 1, 0) - 1
    If Weekday(d, vbSunday) = 7 Then
        k = k + 1
        OArr(k, 1) = d
    End If
Next d

If k = 4 Then OArr(k + 1, 1) = "-"

For Each uRng In unionRange.Areas
    uRng.Value = OArr
    uRng.NumberFormat = "dd-mmmm"
Next uRng

For Each chCell In chRng.Cells
    chCell.MergeArea.Locked = (chCell.Value <> "")
Next chCell

EssentialWrite.Value = OArr
EssentialWrite.NumberFormat = "dd-mmmm"

ActiveSheet.Protect


End Sub

The main parts of the code are the

ActiveSheet.Unprotect


For Each chCell In chRng.Cells
chCell.MergeArea.Locked = (chCell.Value <> "") Next chCell


ActiveSheet.Protect

Currently the code executes with zero errors. However the range of cells is not locked at all and is actually editable in its entirety. Im doing this to prevent unexpected user entries in the specified cells Any advice on what may work.

Im sorry if the code is a little messy. Im kinda just hacking together at this point and relatively new to this

Upvotes: 0

Views: 465

Answers (2)

learnAsWeGo
learnAsWeGo

Reputation: 2282

This code locks only the code that say LOCKED in the image below.

Sub lockCells()

    Dim ws As Worksheet
    Set ws = Sheets("Sheet1")

    ws.Cells.Locked = False

    Dim rng As Range
    Set rng = ws.Range("A1:A10")

    Dim cell As Range

    For Each cell In rng
        cell.Locked = cell.Value <> ""
    Next cell

    ws.Protect 1234
End Sub

enter image description here

Upvotes: 1

CLR
CLR

Reputation: 12289

I'm not sure this is 'best practice' but I'd use:

chCell.Cells(1, 1).Locked = (chCell.Value <> "")

Upvotes: 0

Related Questions