Restrict Copy, Paste Drag ina certain range, in certain sheet.

salta301

New Member
Joined
Nov 27, 2020
Messages
2
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Dear Masters!
I do have a code that helps me to stop drag and dropping in certain ranges (In another ranges drag and drop is active)
But this code also had to restrict Copy and Paste in those ranges, but it deactivates Pasting at all! Which is quite uncomfortable!
I dotn want to fix it by using Enable. Events=False, or some other independent macro, that i will have to be ruuning everytime when I need Pasting.
I want just to find out the probable mistake in this existing code, or to add fix into it.

Code is below
In This Workbook:
VBA Code:
Option Explicit
Private Sub Workbook_Activate()
     'Force the current selection to be selected, triggering the appropriate
     'state of the cut, copy & paste commands
    Call ChkSelection(ActiveSheet)
    Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
     'Re-enable the cut, copy & paste commands
    Call ToggleCutCopyAndPaste(True)
    Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Deactivate()
     'Re-enable the cut, copy & paste commands
    Call ToggleCutCopyAndPaste(True)
    Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Open()
     'Force the current selection to be selected, triggering the appropriate
     'state of the cut, copy & paste commands
    Application.CutCopyMode = True
    Call ChkSelection(ActiveSheet)
    Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call ChkSelection(Sh)
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     'Toggle the cut, copy & paste commands on selected ranges
    Call ChkSelection(Sh)
End Sub
Private Sub Worksheet_Deactivate(ByVal Sh As Object)
    'Call ChkSelection(Sh)
    'Call ToggleCutCopyAndPaste(True)
End Sub

And in the Module:
VBA Code:
Option Explicit
Public Function InRange(Range1 As Range, Range2 As Range) As Boolean
' Added function to check if Cell is In Range
' returns True if Range1 is within Range2'
Dim InterSectRange As Range
    Set InterSectRange = Application.Intersect(Range1, Range2)
    InRange = Not InterSectRange Is Nothing
    Set InterSectRange = Nothing
End Function
Sub ChkSelection(ByVal Sh As Object)
    'Added Primarily to have one place to set restrictions
    'It also fixes the issue where a cell you don't want to
    'copy/paste from/to is already selected, but you
    'came from a sheet that wasn't protected.
      
    Dim rng As Range
    Set rng = Range(Selection.Address)
  
    Select Case Sh.Name
    Case Is = "Sheet1"
        'Disable copy and paste for anything in column A
        If InRange(rng, Columns("A")) Then
            Call ToggleCutCopyAndPaste(False)
        Else
            Call ToggleCutCopyAndPaste(True)
        End If
  
    Case Is = "Main"
        'Disable copy and paste for anything in range G1 to G20
        If InRange(rng, Range("K1:K3,G1:G3")) Then
            Call ToggleCutCopyAndPaste(False)
        Else
            Call ToggleCutCopyAndPaste(True)
        End If
  
    Case Else
        Call ToggleCutCopyAndPaste(True)
    End Select
  
End Sub
Sub ToggleCutCopyAndPaste(Allow As Boolean)
     'Activate/deactivate cut, copy, paste and pastespecial menu items
    Call EnableMenuItem(21, Allow) ' cut
    Call EnableMenuItem(19, Allow) ' copy
    Call EnableMenuItem(22, Allow) ' paste
    Call EnableMenuItem(755, Allow) ' pastespecial
       
  
     'Drag and Drop Disabled from Original code due to deselecting what has been
     'copied and not allowing paste.  Moved to when workbook opens.
     'Drag and drop will not be allowed for entire workbook.
       
     'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
    With Application
        Select Case Allow
        Case Is = False
            .OnKey "^c", "CutCopyPasteDisabled"
            .OnKey "^v", "CutCopyPasteDisabled"
            .OnKey "^x", "CutCopyPasteDisabled"
            .OnKey "+{DEL}", "CutCopyPasteDisabled"
            .OnKey "^{INSERT}", "CutCopyPasteDisabled"
            Application.CellDragAndDrop = False
            Application.CopyObjectsWithCells = False
        Case Is = True
            .OnKey "^c"
            .OnKey "^v"
            .OnKey "^x"
            .OnKey "+{DEL}"
            .OnKey "^{INSERT}"
            Application.CellDragAndDrop = True
            Application.CopyObjectsWithCells = True
        End Select
    End With
End Sub
   
Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
     'Activate/Deactivate specific menu item
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub
   
Sub CutCopyPasteDisabled()
     'Inform user that the functions have been disabled
    MsgBox "Sorry! Cutting, copying and pasting have been disabled for the specified range."
End Sub
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,734
Snazzy code! Didn't know you could interact with the menu like that.
What happens when you comment out the paste disabling lines? Does pasting then work OK?

Have you tried setting a bookmark and then stepping through the code in unprotected areas?
 

salta301

New Member
Joined
Nov 27, 2020
Messages
2
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Dear, I tried a lot of things! But it does not work!
 

Watch MrExcel Video

Forum statistics

Threads
1,123,252
Messages
5,600,543
Members
414,386
Latest member
PARAMATHMA SENTHILNATHAN

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top