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 Validation for these cells to Whole Number. This seems to work fine when I try to enter any non whole number values manually it throws an error and accepts only whole numbers so till here this is good. But when I copy from any other excel or non excel application and paste in these cells it accepts the values and let it paste ignoring the data validation settings. So I added the below code to restrict it to only numbers but this code is allowing decimals as well since the funtion is IsNumeric and blocking only alpha chars. Is there any function which allows only Whole Numbers.

 

'Only numeric values
Const CELL_ADDRESS = "$A$1:$A$3" 'change range
If Not Application.Intersect(Target, Range(CELL_ADDRESS)) Is Nothing Then
If Not Int(Target.Value) Then
MsgBox "You must enter only numeric values", vbCritical, "Invalid Input"
Target.Value = vbNullString
End If
End If

End Sub

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

6 Replies

  • NikolinoDE's avatar
    NikolinoDE
    Platinum Contributor
    Mar 26, 2021
    TRIM removes the digits after the decimal point.

    Matrix formula:
    = SUM (TRIM (A1: A3))

    Additional Formulas:
    =INT(A1)
    =TRUNC(A1)
    =ROUND(A1,0)

    Hope I was able to help you with this info.

    Nikolino
    I know I don't know anything (Socrates)
    • Abdullah_Shurjeel's avatar
      Abdullah_Shurjeel
      Copper Contributor
      Mar 27, 2021
      Thanks Nikolino for the response.
      The formulas are helpful for removal of decimal points.
  • 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

         

Resources