ClipBoard Not Clearing: #Application.CutCopyMode=False#

[TFiske]

I have a macro that runs two separate Copy/Paste events. I did some reasearch and found that I should add

Application.CutCopyMode = False

To the end of each of my Paste commands to clear the clipboard. However, the command is not clearing the clipboard.

Both events are identical, only the copy range, the paste location and the Boolean variable "loopBool" change.

' Finds the end of the table by searching for the cell value "END" in Column A
' and Pastes the data from "Flower Order Entry" there
    Sheets("Flower Orders").Activate
    Dim loopBoola As Boolean
    loopBoola = True
    Sheets("Flower Orders").Range("A1").Activate
    Do While loopBoola = True
        If ActiveCell.Value = "END" Then
            loopBoola = False
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    Loop
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' Should clear the clipboard, but does not.
    Application.CutCopyMode = False

I would also like to add a command at the end to save the workbook each time the macro runs. I've done some looking but I can't quite figure it out. I've attached a sample copy. More generally, any feedback on the code would be appreciated, this is my first successful macro project and I'd like to get some feedback. Thank you.

[xlnitwit]

Hi,

That command will not clear the Office clipboard, if that is what you were expecting?

[TFiske]

I suppose. I guess I'm not sure. Very new to VBA.

If I monitor the clipboard pannel, the copied data is shown as still as being on the clipboard after the macro runs. See attached screenshots of before and after the macro runs.

Do I need code that specifies a specific clipboard?

[xlnitwit]

Do you have a particular need to clear that? The code is a little involved.

[TFiske]

I thought it would be prudent. Ultimately the macro will be run nearly 100 times by the user as new orders are entered. I was concerned about that much data getting built up on the clipboard and slowing down the program or leading to instability.

As a side note, if the "Application.CutCopyMode=False" is not doing what I thought, what is it doing? :-P

[CK76]

Try putting below in another module. And then call it from your main procedure.

Code was originally written by Jaafar Tribak. But I seem to have misplaced the link to the thread.

Option Explicit

Private Type POINTAPI
  x As Long
  Y As Long
End Type

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
#If VBA7 Then
    Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongPtr, ppacc As Any, pvarChild As Variant) As Long
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
    Dim hwndClip As LongPtr
    Dim hwndScrollBar As LongPtr
    Dim lngPtr As LongPtr
#Else
    Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Dim hwndClip As Long
    Dim hwndScrollBar As Long
#End If

Const GW_CHILD = 5
Const S_OK = 0

Sub ClearOfficeClipBoard()

    Dim tRect1 As RECT, tRect2 As RECT
    Dim tPt As POINTAPI
    Dim oIA As IAccessible
    Dim vKid  As Variant
    Dim lResult As Long
    Dim i As Long
    Static bHidden As Boolean
      
    If CommandBars("Office Clipboard").Visible = False Then
        bHidden = True
        CommandBars("Office Clipboard").Visible = True
        Application.OnTime Now, "ClearOfficeClipBoard": Exit Sub
    End If

    hwndClip = FindWindowEx(Application.hwnd, 0, "EXCEL2", vbNullString)
    hwndClip = FindWindowEx(hwndClip, 0, "MsoCommandBar", CommandBars("Office Clipboard").NameLocal)
    hwndClip = GetNextWindow(hwndClip, GW_CHILD)
    hwndScrollBar = GetNextWindow(GetNextWindow(hwndClip, GW_CHILD), GW_CHILD)
    
    If hwndClip And hwndScrollBar Then
        GetWindowRect hwndClip, tRect1
        GetWindowRect hwndScrollBar, tRect2
        BringWindowToTop Application.hwnd
        For i = 0 To tRect1.Right - tRect1.Left Step 50
            tPt.x = tRect1.Left + i: tPt.Y = tRect1.Top - 10 + (tRect2.Top - tRect1.Top) / 2
            #If VBA7 And Win64 Then
                CopyMemory lngPtr, tPt, LenB(tPt)
                lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
            #Else
                lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
            #End If
            If InStr("Clear All - Borrar todo - Effacer tout", oIA.accName(vKid)) Then
                Call oIA.accDoDefaultAction(vKid): CommandBars("Office Clipboard").Visible = Not bHidden: bHidden = False: Exit Sub
            End If
            DoEvents
        Next i
    End If
    CommandBars("Office Clipboard").Visible = Not bHidden
    MsgBox "Unable to clear the Office Clipboard"

End Sub

[TFiske]

The code is a little involved.

--xlnitwit

...Yes. Please forgive, how and where would I set up the call command in my main procedure:

Sub FlowerOrderWizard()
'
' Keyboard Shortcut: Ctrl+t
'
' Declared variables to copy/paste order entry form from "Flower Order Entry"
Dim SrtRange As Range
Dim OrderRange As Range
Dim ClrOrderRange As Range

' Declared variables for start cell of dynamic range to copy/paste
' Order Summary from "Flower Order Entry"
Dim StartCell As Range
Dim OrdrSumHeight As Integer

' Set Variables to copy paste Flower Order Form to the Total Order Tab
Set SrtRange = Sheets("Flower Order Entry").Range("B2")
Set OrderRange = Sheets("Flower Order Entry").Range("A4:AE28")
Set ClrOrderRange = Sheets("Flower Order Entry").Range("E4:AE26")

' Set Variables for dynamic copy/paste range for Order Summary to copy/paste
' it to the "Orders by Group Tab"
Set StartCell = Sheets("Flower Order Entry").Range("A29")
    OrdrSumHeight = Sheets("Flower Order Entry").Cells(1, 1)

' Copy Range A4:AE28 from "Flower Order Entry"
    Sheets("Flower Order Entry").Activate
    OrderRange.Select
    Selection.Copy
    
' Finds the end of the table by searching for the cell value "END" in Column A
' and Pastes the data from "Flower Order Entry" there
    Sheets("Flower Orders").Activate
    Dim loopBoola As Boolean
    loopBoola = True
    Sheets("Flower Orders").Range("A1").Activate
    Do While loopBoola = True
        If ActiveCell.Value = "END" Then
            loopBoola = False
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    Loop
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' Should clear the clipboard, but does not.
    Application.CutCopyMode = False
        
' Dynamically resized to copy the Order Summary
    Sheets("Flower Order Entry").Activate
    StartCell.Resize(OrdrSumHeight, 5).Select
    Selection.Copy
    
' Find the end of the data by looping through Column A for the cell value
' "END" and pasts the order summary there.
    Sheets("Orders by Group").Activate
    Dim loopBoolb As Boolean
    loopBoolb = True
    Sheets("Orders by Group").Range("A1").Activate
    Do While loopBoolb = True
        If ActiveCell.Value = "END" Then
            loopBoolb = False
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    Loop
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' Should clear the clipboard, but does not
    Application.CutCopyMode = False
            
    Sheets("Flower Order Entry").Activate
    ClrOrderRange.ClearContents
    SrtRange.ClearContents
    SrtRange.Select
    
'Should clear the clipboard, but does not.
    Application.CutCopyMode = False
            
End Sub

[Mumps1]

I've tidied the code up a bit. Try this version:

Sub FlowerOrderWizard()
    '
    ' Keyboard Shortcut: Ctrl+t
    '
    ' Declared variables to copy/paste order entry form from "Flower Order Entry"
    Dim SrtRange As Range
    Dim OrderRange As Range
    Dim ClrOrderRange As Range
    
    ' Declared variables for start cell of dynamic range to copy/paste
    ' Order Summary from "Flower Order Entry"
    Dim StartCell As Range
    Dim OrdrSumHeight As Integer
    
    ' Set Variables to copy paste Flower Order Form to the Total Order Tab
    Set SrtRange = Sheets("Flower Order Entry").Range("B2")
    Set OrderRange = Sheets("Flower Order Entry").Range("A4:AE28")
    Set ClrOrderRange = Sheets("Flower Order Entry").Range("E4:AE26")
    
    ' Set Variables for dynamic copy/paste range for Order Summary to copy/paste
    ' it to the "Orders by Group Tab"
    Set StartCell = Sheets("Flower Order Entry").Range("A29")
    OrdrSumHeight = Sheets("Flower Order Entry").Cells(1, 1)
    
    ' Copy Range A4:AE28 from "Flower Order Entry"
    OrderRange.Copy
    Sheets("Flower Orders").Activate
    Application.DisplayAlerts = False
    Cells(Sheets("Flower Orders").Range("A:A").Find("END").Row, 1).PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = True
    Application.CutCopyMode = False
            
    ' Dynamically resized to copy the Order Summary
    StartCell.Resize(OrdrSumHeight, 5).Copy
    Sheets("Orders by Group").Activate
    Cells(Sheets("Orders by Group").Range("A:A").Find("END").Row, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
        
    Sheets("Flower Order Entry").Activate
    ClrOrderRange.ClearContents
    SrtRange.ClearContents
    SrtRange.Select
End Sub

What is the full path of the folder where you want to save the file? What name do you want to use to save it keeping in mind that you will be saving it each time the macro runs?

[TFiske]

The full file path would be:

H:\PK\Adopt-A-Planter\Flower Order Wizard.xlsm

I tried your version of the code. The copied data still appears on the clipboard, although your code does look much more efficient. Thank you.

[CK76]

At end of procedure. Or at each line after where you have Application.CutCopyMode = False

Put following:

Call ClearOfficeClipBoard

[TFiske]

It worked beautifully. Thank you all!! Since my main issue is resolved, I'll mark the thread as solved. I'd still like to learn how to include a save command in my code.

[Mumps1]

Includes "save" command.

Sub FlowerOrderWizard()
    Appliaction.screnupdating = False
    ' Keyboard Shortcut: Ctrl+t
    '
    ' Declared variables to copy/paste order entry form from "Flower Order Entry"
    Dim SrtRange As Range
    Dim OrderRange As Range
    Dim ClrOrderRange As Range
    
    ' Declared variables for start cell of dynamic range to copy/paste
    ' Order Summary from "Flower Order Entry"
    Dim StartCell As Range
    Dim OrdrSumHeight As Integer
    
    ' Set Variables to copy paste Flower Order Form to the Total Order Tab
    Set SrtRange = Sheets("Flower Order Entry").Range("B2")
    Set OrderRange = Sheets("Flower Order Entry").Range("A4:AE28")
    Set ClrOrderRange = Sheets("Flower Order Entry").Range("E4:AE26")
    
    ' Set Variables for dynamic copy/paste range for Order Summary to copy/paste
    ' it to the "Orders by Group Tab"
    Set StartCell = Sheets("Flower Order Entry").Range("A29")
    OrdrSumHeight = Sheets("Flower Order Entry").Cells(1, 1)
    
    ' Copy Range A4:AE28 from "Flower Order Entry"
    OrderRange.Copy
    Sheets("Flower Orders").Activate
    Application.DisplayAlerts = False
    Cells(Sheets("Flower Orders").Range("A:A").Find("END").Row, 1).PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = True
    Application.CutCopyMode = False
            
    ' Dynamically resized to copy the Order Summary
    StartCell.Resize(OrdrSumHeight, 5).Copy
    Sheets("Orders by Group").Activate
    Cells(Sheets("Orders by Group").Range("A:A").Find("END").Row, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
        
    Sheets("Flower Order Entry").Activate
    ClrOrderRange.ClearContents
    SrtRange.ClearContents
    SrtRange.Select
    ActiveWorkbook.SaveAs Filename:="H:\PK\Adopt-A-Planter\Flower Order Wizard.xlsm"
    Appliaction.screnupdating = True
End Sub

[TFiske]

Thanks. This is great. I didn't think it would be that simple. Again, thank you all!

[Mumps1]

You are very welcome.