Rob_010101
Board Regular
- Joined
- Jul 24, 2017
- Messages
- 198
- Office Version
- 365
- Platform
- Windows
Hello,
Really silly question but I have no idea how to do this:
I need to add these two:
Into the below, so I can get the below to work on a protected workbook. The ZZZ I will amend to the protection password later but it basically needs to unprotect my workbook, run the code and then reprotect it.
Man, I need to learn how to use this properly, so useful!
kind Regards
Really silly question but I have no idea how to do this:
I need to add these two:
VBA Code:
Me.Protect Password:="zzz"
VBA Code:
Me.Unprotect Password:="zzz"
Into the below, so I can get the below to work on a protected workbook. The ZZZ I will amend to the protection password later but it basically needs to unprotect my workbook, run the code and then reprotect it.
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
Man, I need to learn how to use this properly, so useful!
kind Regards