Format & Protect range of cells using VBA

[Gajendran Yadhav]

Dear All,
I'm working on an Excel workbook where i have certain data.

I have the following code in the Worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim dateList As String
    Dim existingList As String
    Dim lastRow As Long
    Dim btn As Button

    ' Find the last row in column M with data
    lastRow = Me.Cells(Me.Rows.Count, "M").End(xlUp).Row
    
    ' Check if the changed cell is within column M and from M5 onwards
    If Not Intersect(Target, Me.Range("M5:M" & lastRow)) Is Nothing Then
        ' Iterate through each changed cell in column M
        For Each cell In Intersect(Target, Me.Range("M5:M" & lastRow))
            ' Check if the cell in column M has a date value
            If IsDate(cell.Value) Then
                ' Retrieve existing date list from corresponding row in column G
                existingList = Me.Cells(cell.Row, "G").Value
                
                ' If the existing list is not empty, append a comma and space
                If existingList <> "" Then
                    existingList = existingList & ", "
                End If
                
                ' Append the new date to the existing date list
                existingList = existingList & Format(cell.Value, "dd/mm/yyyy")
                
                ' Write the updated date list back to the corresponding row in column G
                Me.Cells(cell.Row, "G").Value = existingList
            End If
        Next cell
    End If

    ' Set the range to the entire 17th column (Column Q)
    Set rng = Intersect(Target, Columns(17))

    ' Check if there are any changes in Column Q
    If Not rng Is Nothing Then
        Application.EnableEvents = False ' Disable events to prevent infinite loop

        ' Loop through each changed cell in Column Q
        For Each cell In rng
            ' Clear the corresponding cells in Columns R (18th) and S (19th)
            cell.Offset(0, 1).ClearContents ' Clear contents of Column R (18th column)
            cell.Offset(0, 2).ClearContents ' Clear contents of Column S (19th column)
            
            ' Add a button to the corresponding row in column U if Q is not empty
            If Not IsEmpty(cell.Value) Then
                ' Add a button to the corresponding row in column U
                AddButtonToRowU cell
            End If
        Next cell

        Application.EnableEvents = True ' Enable events after the changes are made
    End If
End Sub

Sub AddButtonToRowU(cell As Range)
    Dim btn As Button
    
    ' Add a button to the corresponding row in column U
    With cell.EntireRow.Range("U1")
        Set btn = Me.Buttons.Add(.Left, .Top, .Width, .Height)
        With btn
            .OnAction = "MarkAsClosed"
            .Caption = "Mark as Closed"
            .Name = "btnMarkClosed_" & cell.Row
        End With
    End With
End Sub

and the following code in a regular module 1:

Sub MarkAsClosed()
    Dim ws As Worksheet
    Dim rowNum As Long
    Dim rowRange As Range
    Dim response As VbMsgBoxResult
    Dim natureOfDisposal As String
    Dim amountRecovered As Variant
    
    ' Set the worksheet
    Set ws = ThisWorkbook.ActiveSheet ' Reference to the active sheet
    
    On Error Resume Next
    ' Get the row number from the button's name
    rowNum = CLng(Mid(Application.Caller, Len("btnMarkClosed_") + 1))
    On Error GoTo 0
    
    ' Check if rowNum is valid
    If rowNum > 0 Then
        ' Display a confirmation message
        response = MsgBox("Are you sure you want to close this row? The action cannot be undone.", vbYesNo + vbQuestion, "Confirmation")
        
        ' Check the user's response
        If response = vbYes Then
            ' Prompt the user to enter the nature of disposal
            natureOfDisposal = InputBox("Please enter the nature of disposal for this case:", "Nature of Disposal")
            
            ' Prompt the user to enter the amount recovered
            amountRecovered = InputBox("Please enter the amount of recoveries (if any) for this case:", "Amount Recovered")
            
            ' Define the range of cells from column A to column W in the clicked row
            Set rowRange = ws.Range("A" & rowNum & ":W" & rowNum)
            
            ' Format the row with Light Green color
            With rowRange.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = RGB(146, 208, 80) ' Light Green color
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            
            ' Unprotect the entire worksheet to modify protection settings
            ws.Unprotect Password:="Unprotect"
            
            ' Protect only the specified range with password "Unprotect"
            rowRange.Locked = True ' Lock the specified range
            
            ' Re-apply protection to the entire worksheet with user interface only
            ws.Protect Password:="Unprotect", UserInterfaceOnly:=True
           
            ' Store the entered data in columns V and W
            ws.Cells(rowNum, "V").Value = natureOfDisposal
            ws.Cells(rowNum, "W").Value = amountRecovered
            
            ' Show a message indicating the row is closed
            MsgBox "The case is marked as Disposed. The nature of disposal and amount of recoveries have been recorded.", vbInformation
        End If
    Else
        MsgBox "Error: Button not found or row number is invalid.", vbExclamation
    End If
End Sub

My requirement is to protect only the range of cells from A:T and V, W.
I'm getting the formatting correct. but the Protection is been applied to the entire sheet.

Please any assistance would be appreciated.

Regards & TIA
Gajendran Yadhav

 

[rabsofty]

if you only want A:T V, W protected,
you have to format all other range of cells as unlocked
so that when you protect the worksheet, A:T V , W will be protected and all others will not

 

[Gajendran Yadhav]

if you only want A:T V, W protected,
you have to format all other range of cells as unlocked
so that when you protect the worksheet, A:T V , W will be protected and all others will not

Hi,
A:T , V, W of particular row alone to be protected on clicking the button in U of that row.

eg: on clicking the button in U10, i want A10:T10 and V10, W10 to be protected.

other cells should be open to edit. reference picture.

on clicking this button, row 5 - A:T, V, W alone be protected.
not other rows...

 

[Gajendran Yadhav]

hello everyone....

any one there to show up some light...???

 

[rabsofty]

if i understand you,
when you click on a button in row 5 column U, A:T, V, W alone be protected in row 5 only
not other rows...

  Sheets(???).UnProtect
  Range("A5:T5").Locked = TRUE
  Range("V5:W5").Locked = TRUE
  Sheets(???).Protect

Where ??? is the sheet name

P.S.
protection works against an entire sheet
cells you lock are protected

 

[Gajendran Yadhav]

In my code, in the regular module I've referred to the Active Sheet...

Set ws = ThisWorkbook.ActiveSheet ' Reference to the active sheet

I have individual files maintained fir each branch office... so i mentioned as Active sheet...
However the Sheets name will be "AP, AS, BH, BR, CG, Corp, GJ, JH, KA, KA2, KL, MH, MP, NB, OD, PB, RJ, SB, UK&UP-West, UP1&2"

Since this workbook is to maintain periodic events, the other rows except those Marked as Closed should be active for editing.

Thus i need only the range specified to be locked.

 

[MARK858]

Since this workbook is to maintain periodic events, the other rows except those Marked as Closed should be active for editing.

As was stated in post 2 you unlock all the cells, lock the cells you want protected then protect the sheet.
Using the code by rabsofty in post 4

  Sheets(???).UnProtect
  Sheets(???).Cells.Locked = False ' unlock all the cells on the sheet
  Sheets(???).Range("A5:T5").Locked = TRUE ' lock all the cells you want protected
  Sheets(???).Range("V5:W5").Locked = TRUE ' lock all the cells you want protected
  Sheets(???).Protect ' protect the sheet

 

[Gajendran Yadhav]

As was stated in post 2 you unlock all the cells, lock the cells you want protected then protect the sheet.
Using the code by rabsofty in post 4

  Sheets(???).UnProtect
  Sheets(???).Cells.Locked = False ' unlock all the cells on the sheet
  Sheets(???).Range("A5:T5").Locked = TRUE ' lock all the cells you want protected
  Sheets(???).Range("V5:W5").Locked = TRUE ' lock all the cells you want protected
  Sheets(???).Protect ' protect the sheet

Dear @MARK858 & @rabsofty ,

Thanks a lot. It worked.

Instead of using the Sheet Name, i used ActiveSheet syntax...

' Unprotect the entire worksheet to modify protection settings
            ws.Unprotect Password:="Unprotect"
            
            ' Protect only the specified range with password "Unprotect"
            ' rowRange.Locked = True ' Lock the specified range
            
            ' Lock specific ranges
            With ActiveSheet
                .Range("A5:T5").Locked = True
                .Range("V5:W5").Locked = True
            End With
            
            ' Re-apply protection to the entire worksheet with user interface only
            ws.Protect Password:="Unprotect", UserInterfaceOnly:=True

I've given the snippet for your reference a well...

in the above snippet,

            ' Protect only the specified range with password "Unprotect"
            ' rowRange.Locked = True ' Lock the specified range

this code was in my original code. I wonder why it didn't work.

Rabysoft's suggested code did the work.

Thanks a lot dear.

and by the way, can you guys help me in other query as well ?
the link is History of Dates to be traced in Excel (2010) in DD/MM/YYYY format