Restrict cells to accept ONLY pasted data

SomethingClever · June 25th, 2009, 12:50 PM

Hi,

I searched existing threads and couldn't find anything that addressed this specific issue, but please feel free to redirect me if I missed something.

I'm working on a spreadsheet to track customer information, but the people who will be using it are not the sharpest knives in the drawer. They have the tendency to transpose or omit numbers when they type, and they don't check their work for errors.

I want to restrict certain cells in my spreadsheet such that all the users can do is paste data from an outside source. I've already locked them out of cells they shouldn't be editing, and I've used Data Validation to set the parameters of acceptable data, but is there a way to prevent typing and allow pasting only?

Much appreciated!

allenm · June 26th, 2009, 11:00 AM

Very interesting. Not sure it's effective to code around training issues. Still, a very interesting scenario.

Okay, this one is a little tricky and requires a bit of tricky coding to work around so I've commented it a bit heavier than usual to make sure you'll be able to understand how it works.

Place the following code as the worksheet_change function of the worksheet you want to "protect":

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Reverts any changed value back if not pasted from clipboard which requires DataObject functionality.
'To use DataObject add the reference (Tools>References): Microsoft Forms 2.0 Object Library
  Dim oDataObj As New DataObject, oPos As Range, oAct As Range
  Dim sFromClip As String, sValue As String, bRevert As Boolean

'The below commented if then shows how you can exit if not a specific column or row so only what you
'want to protect will be processed.
'  if target.Row <> [Row you are protecting]  or target.Column <> [column you are protecting] then exit sub

  If Target.Count > 1 Then Exit Sub 'if cell range of source is > 1 cell then it's a copied range

'Selection and active cell will revert to changed cell if reversion occurs.
'To prevent this we'll manually store it and set it back if it does
  Set oPos = Selection
  Set oAct = ActiveCell

'Get clipboard content.  If the format isn't recognized, revert value
  oDataObj.GetFromClipboard
  If oDataObj.GetFormat(1) = False Then
    bRevert = True
  Else
'If the format is recognized, strip out cr and lf from compare strings.
'An extra cr and lf are added to text value of range when range is copied
    sFromClip = Replace(oDataObj.GetText(1), vbLf, "")
    sFromClip = Replace(sFromClip, vbCr, "")
    sValue = Replace(Target.Value, vbLf, "")
    sValue = Replace(Target.Value, vbCr, "")
    If sFromClip <> sValue Then bRevert = True
  End If
  If bRevert Then
    Application.EnableEvents = False 'Disable events so undo doesn't fire this event
    Application.Undo 'Undo to revert to previous
'Reselect and activate appropriate cell(s) after undo
    oPos.Select
    oAct.Activate
    Application.EnableEvents = True 'Re-enable events to allow coded events to fire again.
  End If

End Sub

Hope this helped and that the remarks within the code made what is being done more understandable.