[SOLVED] Unlock a specif Row Range based on the date

Unlock a specif Row Range based on the date

I need some help to upgrade my VBA code.

I try to find a code which will unlock a specific row based on the current date. The problem is, I don't want all the row's cells to be unlocked but only a set of specific range. Like on the current date which are in the column "B", the cells unlocked will be from ("D" to "K"); ("M" to "P"); ("R"to"S") and ("U"to"V").

The cells in-between contain formulas that I don't want people to mess up or change by mistake.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Range("B" & Selection.Row).Value <> Date Then
        ActiveSheet.Protect Password:="3827"
        MsgBox "Only today's date needs to be edited!", vbInformation, "REMINDER"
    ElseIf Range("B" & Selection.Row).Value = Date Then
        ActiveSheet.Unprotect Password:="3827"
        ActiveSheet.EnableSelection = xlNoRestrictions
    End If
End Sub

Solution

Why not take it a step further? Only let them select the row of Today's date of those columns when the worksheet is activated!

Option Explicit

Private Const PWD As String = "3827"
Private Const UNLOCK_COLS As String = "D:K,M:P,R:S,U:V"

Private Sub Worksheet_Activate()
    Dim dToday As Date, oRng As Range, oItem As Variant
    dToday = Date
    With ActiveSheet
        .Unprotect Password:=PWD
        .Cells.Locked = True
        ' Look for row with today's date and unlock the row inside usedrange
        Set oRng = .Columns("B").Find(What:=dToday)
        If Not oRng Is Nothing Then
            For Each oItem In Split(UNLOCK_COLS, ",")
                Intersect(oRng.EntireRow, .Columns(oItem)).Locked = False
            Next
        End If
        .Protect Password:=PWD
        .EnableSelection = xlUnlockedCells
    End With
End Sub

With optimisation sugguestion from Tim Williams, you can even skip the loop:

Option Explicit

Private Const PWD As String = "3827"
Private Const UNLOCK_COLS As String = "D1:K1,M1:P1,R1:S1,U1:V1"

Private Sub Worksheet_Activate()
    Dim dToday As Date, oRng As Range
    dToday = Date
    With ActiveSheet
        .Unprotect Password:=PWD
        .Cells.Locked = True
        ' Look for row with today's date and unlock the specific columns in the row
        Set oRng = .Columns("B").Find(What:=dToday)
        If Not oRng Is Nothing Then oRng.EntireRow.Range(UNLOCK_COLS).Locked = False
        .Protect Password:=PWD DrawingObjects:=False, Contents:=True, Scenarios:=True ' This allows Adding comments
        .EnableSelection = xlUnlockedCells
    End With
End Sub