Rob_010101
Board Regular
- Joined
- Jul 24, 2017
- Messages
- 198
- Office Version
- 365
- Platform
- Windows
Hello,
I have the below piece of code which moves a row of data to another sheet within the workbook, based on the value from a data validation list. The code works perfectly.
However, the sheet it moves the data from has a lot of formulas in it and people who use the sheet keep accidentally overwriting the formulas. I would usually protect the sheet with the formulas to prevent this but the protection seems to stop the VB code working.
Is it possible to modify the below code to unprotect the sheet with a password, complete the original action and then re-lock it using the same password and with the below protection options?
I have the below piece of code which moves a row of data to another sheet within the workbook, based on the value from a data validation list. The code works perfectly.
However, the sheet it moves the data from has a lot of formulas in it and people who use the sheet keep accidentally overwriting the formulas. I would usually protect the sheet with the formulas to prevent this but the protection seems to stop the VB code working.
Is it possible to modify the below code to unprotect the sheet with a password, complete the original action and then re-lock it using the same password and with the below protection options?
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%
Dim archiveRow%
Dim strMatch As String
Dim wsTarget As Worksheet 'sheet to move data to
Dim blnMove As Boolean 'whether to move data or not
Dim blnOnlyValues As Boolean 'determine if it´s the arvjice
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Range("S2:S1500")) Is Nothing Then 'amend this range address to your
blnOnlyValues = False
Select Case UCase(Target.Value) 'as you have given both "closed" and "Closed"
Case "CLOSED"
Set wsTarget = ThisWorkbook.Worksheets("Archived Absence")
blnMove = True
blnOnlyValues = True
Case "PHASED RETURN"
Set wsTarget = ThisWorkbook.Worksheets("Phased Return")
blnMove = True
blnOnlyValues = True
Case "LTS"
Set wsTarget = ThisWorkbook.Worksheets("Long Term")
blnMove = True
Case Else
blnMove = False
End Select
If blnMove Then
'section of code is taken from your posting
fromRow = ActiveCell.Row
With wsTarget 'only change made here
If .FilterMode Then
strMatch = "match" & Replace("(2,1/(a:a>""""),1)", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
archiveRow = Evaluate(strMatch) + 1
Else
archiveRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(3).Row + 1
End If
End With
Range(Cells(fromRow, 1), Cells(fromRow, 20)).Copy wsTarget.Cells(archiveRow, 1)
With wsTarget '<-- added
.Range(.Cells(archiveRow, 1), .Cells(archiveRow, 20)).FormatConditions.Delete '<-- added
End With '<-- added
If blnOnlyValues Then wsTarget.Cells(archiveRow, 1).Resize(1, 20).Value = Cells(fromRow, 1).Resize(1, 20).Value
Application.EnableEvents = False '<-- added
Rows(fromRow).EntireRow.Delete
Application.EnableEvents = True '<-- added
Set wsTarget = Nothing
End If
End If
End Sub
Kind Regards