Gajendran Yadhav
Board Regular
- Joined
- Sep 8, 2023
- Messages
- 51
- Office Version
- 2010
- 2007
- Platform
- Windows
Dear All,
I'm working on an Excel workbook where i have certain data.
I have the following code in the Worksheet module:
and the following code in a regular module 1:
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
I'm working on an Excel workbook where i have certain data.
I have the following code in the Worksheet module:
VBA Code:
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 Suband the following code in a regular module 1:
VBA Code:
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 SubMy 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
