Disable drag and drop for a selected range under a certain conditi

V

Valeria

Dear experts,
I realise my post is quite long - I wanted to be as clear as possible.
Thanks for helping!!!
I have a code running under the woksheet object of my worksheet (see below).
Basically, in a column users can say "Y" or "N" to a certain condition
(vrange), their name is picked up automatically and the date of the change,
too in 2 other columns. They can also input a validity timeframe in months
for their input (vvrange), and in the column nearby the expiration date is
calculated.
The difference between "Y" and "N" is that, if they say no, they have to
enter a text in another column, and the validity timeframe is fixed to 1
month, and this "1 month" cell is protected.
The problem I am having, apparently because of this protection, is that if
users drag and drop the "N" cell with the autofilter on, Excel does not just
populate the lines selected with the autofilter, but all of the range between
the first filtered line number and the last one! (as it was always happening
with previous versions of Excel).

Do you know why this happens? And if I can't avoid it, is there a way to
disable the autofilter only for the cells where users input "N"?

Many thanks in advance!

Best regards,
Valeria

My code is:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim vrange As Range
Dim vvrange As Range
Dim Ans As Integer
Dim cell As Object
Set vrange = Range("ID_Conf")
Set vvrange = Range("Approval_Granted_For")
Me.Unprotect Password:="my_password"
Application.EnableEvents = False
On Error Resume Next
For Each cell In Target
If Union(cell, vrange).Address = vrange.Address Then
If cell.Value = "Y" Then
Target.Offset(0, 1).Value = Application.UserName
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
ElseIf cell.Value = "N" And cell.Offset(0, 5) <> "" Then
Target.Offset(0, 1).Value = Application.UserName
Target.Offset(0, 2).Value = Format(Date, "DD-MMM-YYYY")
Target.Offset(0, 3) = "1"
Target.Offset(0, 3).Locked = True
Target.Offset(0, 4) = Month(Now - 33 + 30) & "/" & "01/" & Year(Now - 33 + 30)
ElseIf cell.Value = "N" And cell.Offset(0, 5) = "" Then
Ans = MsgBox("Before you can reject, you must enter" & Chr(13) & "a
reason!", 16, "PLEASE READ")
cell.Value = ""
End If
ElseIf Union(cell, vvrange).Address = vvrange.Address Then
Target.Offset(0, 1).Value = Month(Now - 33 + 30 * Target.Cells.Value) & "/"
& "01/" & Year(Now - 33 + 30 * Target.Cells.Value)
End If
Next cell
On Error GoTo 0
Application.EnableEvents = True
Me.Protect Password:="my_password", DrawingObjects:=True, Contents:=True,
Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top