Force Paste Special Values

[hatman]

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:

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?

 

[Jonmo1]

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.

 

[hatman]

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?

 

[hatman]

I think thi sis the solution:

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

 

[lenze]

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?

I'm pretty sure you can disable Drag and Drop.
In the ThisWorkbook module

Private Sub Workbook_Open()
    Application.CellDragAndDrop = False
End Sub

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

lenze

 

[hatman]

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?

 

[lenze]

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?

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

 

[Legacy 98055]

A variation of this method may work.

<table width="100%" border="1" bgcolor="White" style="filterrogid: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>

 

[hatman]

So this is what I ended up with, for anyone interested:

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...)

 

[tightwad]

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!