Data Validation Settings fails to apply

[Abdullah_Shurjeel]

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

[#2 · Accepted solution]

@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

[#3]

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)

[#4]

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

[#5]

@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

[#6]

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.

[#7]

Thanks Nikolino for the response.
The formulas are helpful for removal of decimal points.