Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 26

Thread: Solved: Disable Cut, Copy, Paste Macro for One Column

  1. #1
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location

    Solved: Disable Cut, Copy, Paste Macro for One Column

    Reproduced from PM...

    Quote Originally Posted by fluteloop_19
    Hi Ken,

    Can you please tell me how to use the Disable Cut, Copy, Paste Macro for one column only (column A)? This is for a template for other users and I need them to be able to copy and paste into the worksheet into other columns, except column A.

    I would really appreciate the help. I have been struggling to find the answer for days for this.

    Thank you very much!
    Shannon

    [vba]'*** In a standard module ***
    Option Explicit

    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

    'Activate/deactivate drag and drop ability
    Application.CellDragAndDrop = Allow

    '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"
    Case Is = True
    .OnKey "^c"
    .OnKey "^v"
    .OnKey "^x"
    .OnKey "+{DEL}"
    .OnKey "^{INSERT}"
    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 in this workbook!"
    End Sub

    '*** In the ThisWorkbook Module ***
    Option Explicit

    Private Sub Workbook_Activate()
    Call ToggleCutCopyAndPaste(False)
    End Sub

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ToggleCutCopyAndPaste(True)
    End Sub

    Private Sub Workbook_Deactivate()
    Call ToggleCutCopyAndPaste(True)
    End Sub

    Private Sub Workbook_Open()
    Call ToggleCutCopyAndPaste(False)
    End Sub[/vba]


    (The code above comes from our KB)

    Hi Shannon,

    The code in the standard module that you reproduced above doesn't change, but the code in the ThisWorkbook module will. I've given you a couple of scenarios that could happen in the Worksheet_SelectionChange routine; the first is excepting the entire column A on Sheet 1, the second is excepting only a specific range on Sheet 2, the third is to leave all other sheets with cut/copy/paste still working.

    [vba]'*** In the ThisWorkbook Module ***
    Option Explicit

    Private Sub Workbook_Activate()
    'Force the current selection to be selected, triggering the appropriate
    'state of the cut, copy & paste commands
    Selection.Select
    End Sub

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Re-enable the cut, copy & paste commands
    Call ToggleCutCopyAndPaste(True)
    End Sub

    Private Sub Workbook_Deactivate()
    'Re-enable the cut, copy & paste commands
    Call ToggleCutCopyAndPaste(True)
    End Sub

    Private Sub Workbook_Open()
    'Force the current selection to be selected, triggering the appropriate
    'state of the cut, copy & paste commands
    Selection.Select
    End Sub

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    'Toggle the cut, copy & paste commands on selected ranges

    Select Case Sh.Name
    Case Is = "Sheet1"
    'Disable cut, copy & paste for Sheet1, Column A
    If Not Intersect(Target, Target.Parent.Columns(1)) Is Nothing Then
    Call ToggleCutCopyAndPaste(False)
    Else
    Call ToggleCutCopyAndPaste(True)
    End If

    Case Is = "Sheet2"
    'Disable cut, copy & paste for Sheet2, Range G1:H5
    If Not Intersect(Target, Target.Parent.Range("G1:H5")) Is Nothing Then
    Call ToggleCutCopyAndPaste(False)
    Else
    Call ToggleCutCopyAndPaste(True)
    End If

    Case Else
    'Re-enable cut copy and paste commands as this is not a restricted sheet
    Call ToggleCutCopyAndPaste(True)
    End Select
    End Sub[/vba]
    Hope this helps,
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  2. #2

    How to Disable cut, copy & paste for multiple cells?

    I have used the code above and tweaked it to work for my workbook. However how do you disable cut, copy & paste for multiple cells?

    In the code mentioned above it mentions:
    Case Is = "Sheet2"
    'Disable cut, copy & paste for Sheet2, Range G1:H5
    If Not Intersect(Target, Target.Parent.Range("G1:H5")) Is Nothing Then
    Call ToggleCutCopyAndPaste(False)
    Else
    Call ToggleCutCopyAndPaste(True)

    But how do I disable Cell (A2,D21,C47, C62:F62,.....)


    Please PLEASE help if you can.

    Regards,

    K

  3. #3
    The original disable cut copy paste disable worked in office 2003---but--doesnt seem to work in office 2007 as i can use the copy and paste in the ribbon- and the clipboard internal to the workbook (ie copy then paste to a second page) --or when opening another workbook---copying pasting from the clipboard. is there a way to disable the clipboard entirely?

  4. #4
    VBAX Newbie
    Joined
    Jul 2010
    Posts
    1
    Location

    Smile Disable Cut, Copy, Paste Macro for selected cell ranges

    Hi,
    Iíve been searching for a solution on disabling cut/paste/copy functions in selected cell ranges rather than the entire worksheet. I couldn't find a really suitable solution until I found the very useful bit of code included in this post. For this I am really grateful.

    As you will see pasted below, Iíve made some very minor modifications to allow a single column to have all the functions and I blocked a certain cell range.

    It works perfectly, except for one small thing. I canít figure out if I did something wrong to cause it, or if something changed in Excel 2003 (Iím on Sp3) since this original post was made.

    The cell range Iíve blocked from using cut/copy/paste successfully blocks cut/copy/paste from right clicks, cut and copy on the toolbar, but the paste button on the toolbar is still visible.

    Can anyone please point me in the right direction?

    *** In the ThisWorkbook Module ***
    Option Explicit
     
    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
     
         'Activate/deactivate drag and drop ability
        Application.CellDragAndDrop = Allow
     
         '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"
            Case Is = True
                .OnKey "^c"
                .OnKey "^v"
                .OnKey "^x"
                .OnKey "+{DEL}"
                .OnKey "^{INSERT}"
            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
    Private Sub Workbook_Activate()
         'Force the current selection to be selected, triggering the appropriate
         'state of the cut, copy & paste commands
        Selection.Select
    End Sub
     
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
         'Re-enable the cut, copy & paste commands
        Call ToggleCutCopyAndPaste(True)
    End Sub
     
    Private Sub Workbook_Deactivate()
         'Re-enable the cut, copy & paste commands
        Call ToggleCutCopyAndPaste(True)
    End Sub
     
    Private Sub Workbook_Open()
         'Force the current selection to be selected, triggering the appropriate
         'state of the cut, copy & paste commands
        Selection.Select
    End Sub
     
    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
         'Toggle the cut, copy & paste commands on selected ranges
     
        Select Case Sh.Name
        Case Is = "Contracting Activity"
             'Disable cut, copy & paste for Contracting Activity, Range D20:AD325
            If Not Intersect(Target, Target.Parent.Range("D20:AD325")) Is Nothing Then
                Call ToggleCutCopyAndPaste(False)
            Else
                Call ToggleCutCopyAndPaste(True)
            End If
     
        Case Is = "Planned Activity"
             'Disable cut, copy & paste for Planned Activity, Range D20:AD325
            If Not Intersect(Target, Target.Parent.Range("D20:AD325")) Is Nothing Then
                Call ToggleCutCopyAndPaste(False)
            Else
                Call ToggleCutCopyAndPaste(True)
            End If
     
        Case Else
             'Re-enable cut copy and paste commands as this is not a restricted sheet
            Call ToggleCutCopyAndPaste(True)
        End Select
    End Sub

  5. #5
    VBAX Newbie
    Joined
    Feb 2012
    Posts
    1
    Location
    Hi Everybody,
    Beginer in macros and VBA, I'm very glad to find what I look for since many days....
    My need is a little bit different : I would like to "Disable Cut, Copy, Paste" for all the sheets, except a specific range in 2 different sheets....
    I've tried to modify the above codes, but it does not work.
    Help Please.

  6. #6

    Enable the "Disable Cut, Copy, Paste" macro code

    Hi Ken,

    I am a newbie at VBA.

    I had a public seminar presentation to do for which I used the code you had uploaded Disable Cut, Copy, Paste.

    However now that my presentation has been done, I need to enable the cut copy paste functions on my workbook. HOW DO I DO THAT? I deleted the macro and saved the file but it still does not work. PLEASE HELP

  7. #7

    Enabling the "Disable Cut, Copy, Paste" macro

    Hi Ken,

    I am a newbie at VBA.

    I had a public seminar presentation to do for which I used the code you had uploaded Disable Cut, Copy, Paste.

    However now that my presentation has been done, I need to enable the cut copy paste functions on my workbook. HOW DO I DO THAT? I deleted the macro and saved the file but it still does not work. PLEASE HELP

  8. #8
    VBAX Newbie
    Joined
    Apr 2013
    Location
    Cleveland, OH
    Posts
    2
    Location

    Solved: Improved Disable Cut,Copy,Paste for specified range

    I know this is an old thread, but seeing that it shows up on Google's page 1 when searching for vba code to disable cut, copy and paste for a specified range and this was the most complete code I've ran across to do the task, I felt it appropriate to update this with a better version.

    Bugs found in Ken's version when running under XL03 and WinXP Sp3:
    1. Will allow a paste into restricted cells if a restricted cell is already selected and you are copying from a different sheet.

    Fix: Add code to check the currently selected cell when you change worksheets.

    2. Visa Versa of the above, if a restricted cell is selected and you need to paste something in another sheet. Say from an external source, when you switch to the other sheet, it is still disabled until you change cells.

    Fix: Same as above. Checking currently selected cell when you change worksheets.

    3. Probably the most important. At least under my system configuration, with drag and drop being disabled on selection change, it will deselect whatever has been copied, thus completely defeating the purpose of being able to copy and paste within cells outside of the restricted range.

    Fix: Moved Disabling drag and drop to encompass the entire workbook. This may or may not be an issue for some, but it is the best I could come up with for now to ensure the cut, copy and paste restrictions work as intended.

    4. The original use of Selection.Select would not trigger the code to check if the selected range is within the restricted range.

    Fix: Switch to calling a sub that will check the activecell against the restricted range.

    Additional Code Change information:
    The actual checking of all ranges has moved to a sub called ChkSelection and added a function called InRange to use to check if the selected cell is within the range that is restricted.

    The following is a modified version of Ken's original Disable Cut,Copy,Paste code....

    Place the follow code into ThisWorkbook
    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 = True
    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
        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
    Place the following code into its own standard module:
    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 = "Sheet2"
            'Disable copy and paste for anything in range G1 to G20
            If InRange(rng, Range("G1:G20")) 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"
            Case Is = True
                .OnKey "^c"
                .OnKey "^v"
                .OnKey "^x"
                .OnKey "+{DEL}"
                .OnKey "^{INSERT}"
            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
    Enjoy and again, sorry for resurrecting an old thread, but like I said, it is the best I've ran across and shows up on Google's page 1, so I thought I would update it with something that functions a bit better for anyone else who runs across this thread.

  9. #9
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,840
    Location
    Peixe,

    Thank you very much. I am definately saving this web page in my snippets library.

    SamT
    Please take the time to read the Forum FAQ

  10. #10
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,461
    This might suffice as well; all the code in the workbook codemodule.

    [vba]
    Private Sub Workbook_Activate()
    ChkSelection ActiveSheet
    Application.CellDragAndDrop = True
    End Sub

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ToggleCutCopyAndPaste True
    Application.CellDragAndDrop = True
    End Sub

    Private Sub Workbook_Deactivate()
    ToggleCutCopyAndPaste True
    Application.CellDragAndDrop = True
    End Sub

    Private Sub Workbook_Open()
    ChkSelection ActiveSheet
    Application.CellDragAndDrop = False
    End Sub

    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ChkSelection Sh
    End Sub

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ChkSelection Sh
    End Sub

    Sub ChkSelection(ByVal Sh As Object)
    Select Case Sh.Name
    Case "Sheet1"
    ToggleCutCopyAndPaste Intersect(Selection, sh.Columns(1)) Is Nothing
    Case "Sheet2"
    ToggleCutCopyAndPaste Not Intersect(Selection, sh.range("G1:G20")) Is Nothing
    Case Else
    ToggleCutCopyAndPaste True
    End Select
    End Sub

    Sub ToggleCutCopyAndPaste(v_true As Boolean)
    EnableMenuItem Array(19, 21, 22, 75), v_true

    For j = 1 To 5
    If v_true Then Application.OnKey Choose(j,"^c", "^v", "^x", "+{DEL}", "^{INSERT}")
    If Not v_true Then Application.OnKey Choose(j,"^c", "^v", "^x", "+{DEL}", "^{INSERT}"), "CutCopyPasteDisabled"
    Next
    End Sub

    Sub EnableMenuItem(ctlId, v_Enabled As Boolean)
    On Error Resume Next

    For Each cb In Application.CommandBars
    If cb.Name <> "Clipboard" Then
    For Each it In ctlId
    cb.FindControl(, it).Enabled = v_Enabled
    Next
    End If
    Next
    End Sub

    Sub CutCopyPasteDisabled()
    MsgBox "Sorry! Cutting, copying and pasting have been disabled for the specified range."
    End Sub
    [/vba]
    Last edited by snb; 04-11-2013 at 06:16 AM.

  11. #11
    VBAX Newbie
    Joined
    Apr 2013
    Location
    Cleveland, OH
    Posts
    2
    Location
    Good job SNB. Looks cleaner for sure. I'm not sure if there would be some unforeseen side effects of moving the subs to ThisWorkbook or not.

    Although, I did see a minor bug that both of us missed.

    Private Sub Workbook_Activate()      
        ChkSelection ActiveSheet      
        Application.CellDragAndDrop = True  
    End Sub
    Should actually read....
    Private Sub Workbook_Activate()      
        ChkSelection ActiveSheet      
        Application.CellDragAndDrop = False  
    End Sub
    With the intent of turning off drag on drop for this workbook, but when switching back and forth between other workbooks, it would turn on and off. As is you could still slip one through if you opened another workbook, then came back to this one.

  12. #12
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,461
    I won't comment on that one.

  13. #13

    Help

    Please, the macro works perfect, but I need to activate it in one sheet for 2 columns, like this:

    [VBA]Sub ChkSelection(ByVal Sh As Object)
    Select Case Sh.Name

    Case "CLIENTE PN"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(15)) Is Nothing

    Case "CLIENTE PJ"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing

    Case "CONCESIONARIOS"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(10)) Is Nothing

    Case "PROVEEDORES"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing

    Case "PROVEEDORES"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing

    Case "EMPLEADOS"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing

    Case Else
    ToggleCutCopyAndPaste True
    End Select
    End Sub
    [/VBA]
    In sheet "PROVEEDORES" only detects the 13th column, but not the 17th column, the rest of the code works, with one exception:

    In Excel 2013 the macro

    [VBA]Sub CutCopyPasteDisabled()
    MsgBox ("Lo sentimos, la fecha no puede ser copiada de otra celda")
    End Sub[/VBA]

    Only runs on a standard module, not in the Thisworkbook module
    Thanks

  14. #14
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,840
    Location
    fyrigoyeno,

    This might work
    [VBA]Case "PROVEEDORES"
    If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
    ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
    End If
    [/VBA]
    Please take the time to read the Forum FAQ

  15. #15
    SamT:

    Thanks for the lightspeed response, your code works perfect

    And thanks to all the rest of you guys, a perfect solution for controling things in a sheet.

    Fyrigoyeno (newbie)

  16. #16
    I just notice that when the macro runs at least one time and then I attemp to close the file I am getting this error:

    Error 1004
    Error in method "Intersect" on object "Global"
    (sorry I dont know how to insert a image from url)
    This is the line with the error:
    [VBA] Case "PROVEEDORES"

    If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
    ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
    End If[/VBA]

    The error comes up each time the macro runs, for example, If I run the macro on Sheet1, the error is present in the line of that sheet. If I run the macro on several Sheets, the error comes in the last sheet used when closing the file
    Help on this please, here is my entire code:

    This workbook module:

    [VBA]Private Sub Workbook_Activate()
    ChkSelection ActiveSheet
    Application.CellDragAndDrop = False
    End Sub

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ToggleCutCopyAndPaste True
    Application.CellDragAndDrop = True
    End Sub

    Private Sub Workbook_Deactivate()
    ToggleCutCopyAndPaste True
    Application.CellDragAndDrop = True
    End Sub

    Private Sub Workbook_Open()
    ChkSelection ActiveSheet
    Application.CellDragAndDrop = False
    End Sub

    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ChkSelection Sh
    End Sub

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ChkSelection Sh
    End Sub

    Sub ChkSelection(ByVal Sh As Object)
    Select Case Sh.Name

    Case "CLIENTE PN"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(15)) Is Nothing

    Case "CLIENTE PJ"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing

    Case "CONCESIONARIOS"
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(10)) Is Nothing

    Case "PROVEEDORES"

    If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
    ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
    End If

    Case "EMPLEADOS"

    If Not Intersect(Selection, Sh.Columns(12)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(12)) Is Nothing
    ElseIf Not Intersect(Selection, Sh.Columns(16)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing
    End If

    Case Else
    ToggleCutCopyAndPaste True
    End Select
    End Sub

    Sub ToggleCutCopyAndPaste(v_true As Boolean)
    EnableMenuItem Array(19, 21, 22, 755), v_true

    For k = 1 To 6
    If v_true Then Application.OnKey Choose(k, "^c", "^j", "^v", "^x", "+{DEL}", "^{INSERT}")
    If Not v_true Then Application.OnKey Choose(k, "^c", "^j", "^v", "^x", "+{DEL}", "^{INSERT}"), "CutCopyPasteDisabled"
    Next
    End Sub

    Sub EnableMenuItem(ctlId, v_Enabled As Boolean)
    On Error Resume Next

    For Each cb In Application.CommandBars
    If cb.Name <> "Clipboard" Then
    For Each it In ctlId
    cb.FindControl(, it).Enabled = v_Enabled
    Next
    End If
    Next
    End Sub



    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Index = 2 Then ' 2'st sheet in workbook
    If Target.Column = 15 Then ' 15'rd and 4th colums are active
    Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
    End If
    End If
    If Sh.Index = 3 Then ' 3'st sheet in workbook
    'End S
    If Target.Column = 13 Then ' 15'rd and 4th colums are active
    Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
    End If
    End If
    If Sh.Index = 4 Then ' 4'st sheet in workbook
    If Target.Column = 10 Then ' 15'rd and 4th colums are active
    Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
    End If
    End If
    If Sh.Index = 5 Then ' 5'st sheet in workbook
    If Target.Column = 13 Then ' 15'rd and 4th colums are active
    Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
    End If
    End If
    If Sh.Index = 5 Then ' 5'st sheet in workbook
    If Target.Column = 17 Then ' 15'rd and 4th colums are active
    Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
    End If
    End If

    If Sh.Index = 6 Then ' 5'st sheet in workbook
    If Target.Column = 12 Then ' 15'rd and 4th colums are active
    Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
    End If
    End If
    If Sh.Index = 6 Then ' 5'st sheet in workbook
    If Target.Column = 16 Then ' 15'rd and 4th colums are active
    Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
    End If
    End If
    End Sub
    [/VBA]

    In a Standard module:

    [VBA]Sub CutCopyPasteDisabled()
    MsgBox "Lo sentimos, la fecha no puede ser copiada de otra celda"


    End Sub
    [/VBA]

    Maybe the error comes with the Sub Workbook_BeforeClose() ??

  17. #17
    The last one:

    When the macro runs on both sheets "PROVEEDORES" and "EMPLEADOS" the warning comes up for ALL the cells, not only for columns 13 and 17 for example.
    Thanks in advance

  18. #18
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,840
    Location
    My first read shows to change these subs
    [vba]Private Sub Workbook_Activate()
    ActiveSheet.Range("A1").Select
    Application.CellDragAndDrop = False
    End Sub [/vba]

    [vba]Private Sub Workbook_Open()
    ActiveSheet.Range("A1").Select
    Application.CellDragAndDrop = False
    End Sub
    [/vba]
    It is Very, Very dangerous to use Sheet.Index. It is equally dangerous to use Sheets(OneIndexNumber). Only if you are looping thru all sheets in a workbook should you use Sheets(i).

    Here is how I would do this sub.

    [VBA]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ShtName As String
    ShtName = Sh.Name
    Dim Col As Long
    Col = Target.Column

    'For certain columns on certain sheets, change Macro name
    If ShtName = "Sheet2" And Col = 15 Then Application.Run ("fecha_hoy")
    If ShtName = "Sheet3" And (Col = 3 Or Col = 13) Then Application.Run ("fecha_hoy")

    [/VBA]
    Last edited by SamT; 05-18-2013 at 10:28 AM.
    Please take the time to read the Forum FAQ

  19. #19
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,840
    Location
    You really need to put "Option Explicit" at the top of all your code modules. You have many undeclared variables and this will help you find them.

    On the VBA menu >> Tools >> Options >> Editor, I recommend checking everything except Drag And Drop. This will really help you find code mistakes.
    Please take the time to read the Forum FAQ

  20. #20
    SamT:
    Ok, this is what I'm getting know:
    All variables declared (option Explicit at the beggining)

    Solved problem in other workbooks with your suggestion:

    [VBA]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim ShtName As String
    ShtName = Sh.Name
    Dim Col As Long
    Col = Target.Column

    If ShtName = "CLIENTE PN" And Col = 15 Then Application.Run ("fecha_hoy")

    If ShtName = "CLIENTE PJ" And Col = 13 Then Application.Run ("fecha_hoy")

    If ShtName = "CONCESIONARIOS" And Col = 10 Then Application.Run ("fecha_hoy")

    If ShtName = "PROVEEDORES" And (Col = 13 Or Col = 17) Then Application.Run ("fecha_hoy")

    If ShtName = "EMPLEADOS" And (Col = 12 Or Col = 16) Then Application.Run ("fecha_hoy")


    End Sub[/VBA]

    Solved problem (all cells controled) in sheets "PROVEEDORES" and "EMPLEADOS" with:

    [VBA] Case "PROVEEDORES"

    If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing

    ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing

    Else: ToggleCutCopyAndPaste True

    End If

    Case "EMPLEADOS"

    If Not Intersect(Selection, Sh.Columns(12)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(12)) Is Nothing

    ElseIf Not Intersect(Selection, Sh.Columns(16)) Is Nothing Then
    ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing

    Else: ToggleCutCopyAndPaste True

    End If[/VBA]

    Getting error 1004 (error in method select of clase range) with this when closing the workbook:

    [VBA]Private Sub Workbook_Activate()
    ActiveSheet.Range("A6").Select
    Application.CellDragAndDrop = False

    End Sub[/VBA]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •