Force Paste Special Values

hatman

hatman

Well-known Member
Joined
Apr 8, 2005
Messages
2,664
HAH... I think i have asked more questions today than in all the time since I became a member... I guess that means I'm pushing the envelope.

Anywho. I have a workbook where I want to retain FORMATS in all of my cells in all of my sheets, but allow the user to enter data. So I got this code to undo PASTE and instead do a PASTE SPECIAL VALUES:

Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim UndoString As String

    On Error GoTo err_handler

    UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If Left(UndoString, 5) = "Paste" Then 'Only allow Paste Special|Values
            Application.ScreenUpdating = False
            Application.Undo
            Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
            Application.ScreenUpdating = True
    End If

    Exit Sub

err_handler:

End Sub

Only I had a co-worker submarine this code by simply entering some data, then dragging to fill across. All my formats went south. Any way to fix that?
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
you could copy the whole sheet to another sheet and Hide it.
Then create a macro to copy / paste special / formats from the hidden sheet to the sheet people enter data on....

Just a thought.
 
Upvote 0
MMM, I think not.

I think I see it, now, though.

if Undostring = "Auto fill"... I think I can do this... the wheel sare rusty, but they are moving slowly.

Looks like I also forgot to disable evnts... what is that code again?
 
Upvote 0
I think thi sis the solution:

Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim UndoString As String
    Dim srce As Range
    Dim trgt As Range

    On Error GoTo err_handler

    UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If Left(UndoString, 5) = "Paste" Then 'Only allow Paste Special|Values
            Application.ScreenUpdating = False
            
            Application.EnableEvents = False
            Application.Undo
            Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            
    ElseIf UndoString = "Auto Fill" Then
    
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        Set trgt = Selection
        
        Application.Undo
        
        Set srce = Selection
        
        srce.Copy
        
        trgt.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        
    End If

    Exit Sub

err_handler:

End Sub
 
Upvote 0
Only I had a co-worker submarine this code by simply entering some data, then dragging to fill across. All my formats went south. Any way to fix that?
Click to expand...

I'm pretty sure you can disable Drag and Drop.
In the ThisWorkbook module
Code: 
Private Sub Workbook_Open()
    Application.CellDragAndDrop = False
End Sub

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



lenze
 
Upvote 0
okay... but I think I would also need to enable and disable in the workbook_deactivate and workbook_activate events respectively, otherwise, the functionality is lost if you swap between various open workbooks... right?
 
Upvote 0
okay... but I think I would also need to enable and disable in the workbook_deactivate and workbook_activate events respectively, otherwise, the functionality is lost if you swap between various open workbooks... right?
Click to expand...

You may be right. If so, that may be all you need. Just play around with it and see. Don't have Excel on this machine now to check, but I think there is also a code to disable AutoFill. Check the VBA help files.

lenze
 
Upvote 0
A variation of this method may work.

<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Worksheet_Change(ByVal Target <font color="#0000A0">As</font> Range)
       <font color="#0000A0">Dim</font> SaveTarget <font color="#0000A0">As</font> Variant, SaveSelection <font color="#0000A0">As</font> Range

       <font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">GoTo</font> Err_OutOfMem
       SaveTarget = Target
       <font color="#0000A0">Set</font> SaveSelection = Selection

       <font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">GoTo</font> Err_Worksheet_Change
       Application.ScreenUpdating = <font color="#0000A0">False</font>
       Application.EnableEvents = <font color="#0000A0">False</font>
       Application.Undo
       Target = SaveTarget
       SaveSelection.Select

  Err_Worksheet_Change:
       Application.EnableEvents = <font color="#0000A0">True</font>
       Application.ScreenUpdating = <font color="#0000A0">True</font>
       <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
  Err_OutOfMem:
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("10262006214841234").value=document.all("10262006214841234").value.replace(/<br \/>\s\s/g,"");document.all("10262006214841234").value=document.all("10262006214841234").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("10262006214841234").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="10262006214841234" wrap="virtual">
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SaveTarget As Variant, SaveSelection As Range

On Error GoTo Err_OutOfMem
SaveTarget = Target
Set SaveSelection = Selection

On Error GoTo Err_Worksheet_Change
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Undo
Target = SaveTarget
SaveSelection.Select

Err_Worksheet_Change:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Err_OutOfMem:
End Sub</textarea>
 
Upvote 0
So this is what I ended up with, for anyone interested:

Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim UndoString As String
    Dim srce As Range

    On Error GoTo err_handler

    UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1)
    
    If Left(UndoString, 5) <> "Paste" And UndoString <> "Auto Fill" Then
        
        Exit Sub
        
    End If
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Undo
            
            
    If UndoString = "Auto Fill" Then
        
        Set srce = Selection
        
        srce.Copy
        
        Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    
        Application.SendKeys "{ESC}"

        Union(Target, srce).Select
        
    Else
    
        Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    Exit Sub

err_handler:

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

The benefit is that it is almost entiirely invisible to the user. IE: autofill works almost exactly the way he expects it to, except: 1) The little autofill icon is not displayed when he is done 2) Undo history is lost... but I also lost it in the original code too (if anyone has any ideas how to prevent he Undo history loss, I'm open...)
 
Upvote 0
I think this code is exactly what I am looking for, but where do I put it? I tried the individual worksheet, and it didn't do anything to stop the Cell formatting from changing

*edit*

Nevermind....Tried the Workbook sheet and that did the trick. This rocks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Undo Stack gets cleared running VBA - Possible Solution to fix this?
Replies
5
Views
128
kellman
K
N
  • Question Question
How do I remove undo from code?
Replies
1
Views
555
noveske
N
B
  • Question Question
When removing links with copy and paste special some values appear in scientific notation or expanded decimal places.
Replies
7
Views
318
BYahr
B
G
  • Question Question
Disable Cut Copy Paste
Replies
1
Views
857
jkpieterse
jkpieterse
C
  • Question Question
Paste Special Values - VBA code
Replies
6
Views
360
jolivanes
jolivanes

Forum statistics

Threads
1,224,592
Messages
6,179,789
Members
452,942
Latest member
VijayNewtoExcel

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top