Forum Discussion

Abdullah_Shurjeel's avatar
Abdullah_Shurjeel
Copper Contributor
Mar 26, 2021
Solved

Data Validation Settings fails to apply

Hope someone can help me on this.   I have 3 cells(A1,A2,A3) for which I want only Whole Numbers like 1,2,3 and do not want decimals like 0.1 or 0.5 and neither want alpha chars so I have set Data ...
excel
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Mar 26, 2021

    Abdullah_Shurjeel 

    Try this:

     

    Private Sub Worksheet_Change(ByVal Target As Range)
    'Only numeric values
    Const CELL_ADDRESS = "A1:A3" 'change range
    Dim rng As Range
    Dim f As Boolean
    If Not Intersect(Target, Range(CELL_ADDRESS)) Is Nothing Then
        For Each rng In Intersect(Target, Range(CELL_ADDRESS))
            If Not IsNumeric(rng.Value) Then
                f = True
            ElseIf Not rng.Value = Int(rng.Value) Then
                f = True
            End If
            If f Then
                MsgBox "You must enter only whole numbers!", vbCritical, "Invalid Input"
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
                Exit For
            End If
        Next rng
    End If
End Sub
HansVogelaar's avatar
HansVogelaar
MVP
Mar 26, 2021

Abdullah_Shurjeel 

Try this:

 

Private Sub Worksheet_Change(ByVal Target As Range)
    'Only numeric values
    Const CELL_ADDRESS = "A1:A3" 'change range
    Dim rng As Range
    Dim f As Boolean
    If Not Intersect(Target, Range(CELL_ADDRESS)) Is Nothing Then
        For Each rng In Intersect(Target, Range(CELL_ADDRESS))
            If Not IsNumeric(rng.Value) Then
                f = True
            ElseIf Not rng.Value = Int(rng.Value) Then
                f = True
            End If
            If f Then
                MsgBox "You must enter only whole numbers!", vbCritical, "Invalid Input"
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
                Exit For
            End If
        Next rng
    End If
End Sub
  • Abdullah_Shurjeel's avatar
    Abdullah_Shurjeel
    Copper Contributor
    Mar 27, 2021
    This is great. Appreciate your quick response.

    I have tested the code, it is accepting whole numbers only even when pasted from other excels or non-excel applications.

    I have 2 questions here:

    Q1: For our sample code we have range of cells from A1 to A3. Suppose I have cells like D8, G10, L9 how do I give input of these cells in the above code?

    Q2: Now the problem I have is any whole number pasted from other excels or non-excel applications clearing my formatting which I would like to completely disable.
    I want to keep the formatting of the cells intact.

    For this I have disabled (Control + C, X, V) from other excels and non excel applications to my working excel with the codes I have mentioned in the bottom
    and disabled right click cut, copy and pasting from excel to excel as well
    but right click pasting is still happening from non excel applications to my working excel
    so when I right click it is giving options of Keep Source Formatting & Match Destination Formatting
    when selected Keep Source Formatting it is also clearing formatting and locking that particular cell.

    I wanted to disable this option of (Right Click Pasting from non excel applications) as well.

    Thank you for all your help! 🙂

    Please see the below codes which I have tried to disable cut, copy and paste:

    Code1:

    'Disable Cut, Copy, Paste & CellDragAndDrop
    Private Sub Workbook_Activate()
    Application.CutCopyMode = False
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "^x", ""
    Application.CellDragAndDrop = False
    End Sub

    Private Sub Workbook_Deactivate()
    Application.CellDragAndDrop = True
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "^x"
    Application.CutCopyMode = False
    End Sub

    Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    Application.CutCopyMode = False
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "^x", ""
    Application.CellDragAndDrop = False
    End Sub

    Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    Application.CellDragAndDrop = True
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "^x"
    Application.CutCopyMode = False
    End Sub

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Application.CutCopyMode = False
    End Sub

    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "^x", ""
    Application.CellDragAndDrop = False
    Application.CutCopyMode = False
    End Sub

    Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Application.CutCopyMode = False
    End Sub

    Code2:

    '*** 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
    • HansVogelaar's avatar
      HansVogelaar
      MVP
      Mar 27, 2021

      Abdullah_Shurjeel 

      You could use

       

      Const CELL_ADDRESS = "D8,G10,L9"

       

      I fear it will be very difficult to make it work 100% the way you want. I recommend instructing users never to use Paste, and only use Paste Values.

      To make it easier, you could assign Ctrl+V (^V) to a macro that pastes values only:

       

      Sub PasteValuesOnly()
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues
End Sub

       

      • Abdullah_Shurjeel's avatar
        Abdullah_Shurjeel
        Copper Contributor
        Mar 27, 2021
        Thank you Hans!

        Cell Address is working.

        You are right about instructing users to never use Past and only use Paste Values but you know by mistake if they do so that will lock the cell and change the cell to the source formatting while pasting.

        So after adding pasting values code, the pasting from non-excel applications to excel still gives right click pasting options of source formatting which I wanted to completely disable.

Resources