I have a script that is formatting Raw Data and appending it to the end of an analysis workbook I have open. The script runs from the analysis workbook as the RAW Data is populated each time.
The script works fine with one exception, I am unable to clear the clipboard on the other workbook and I suspect that this is due to it being open in another instance(Application) of Excel.
Sub Data_Ready_For_Transfer()
Dim wb As Workbook
Dim ws As Worksheet
Dim rnglog As Range
Dim lastrow As Range
Dim logrange As Range
Dim vlastrow As Range
Dim vlastcol As Range
Dim copydata As Range
Dim pastecell As Range
Dim callno As Range
Set wb = GetObject("Book1")
Set ws = wb.Worksheets("Sheet1")
Application.ScreenUpdating = False
'if we get workbook instance then
If Not wb Is Nothing Then
With wb.Worksheets("Sheet1")
DisplayAlerts = False
ScreenUpdating = False
.Cells.RowHeight = 15
Set rnglog = wb.Worksheets("Sheet1").Range("1:1").Find(What:="Log Date", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set lastrow = rnglog.EntireColumn.Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set logrange = wb.Worksheets("Sheet1").Range(rnglog, lastrow)
rnglog.EntireColumn.Offset(0, 1).Insert
rnglog.EntireColumn.Offset(0, 1).Insert
rnglog.EntireColumn.Offset(0, 1).Insert
rnglog.EntireColumn.TextToColumns Destination:=rnglog, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 9)), TrailingMinusNumbers:=True
rnglog.Value = "Log Date"
rnglog.Offset(0, 1).Value = "Time"
logrange.Offset(0, 2).FormulaR1C1 = "=WEEKNUM(RC[-2])"
logrange.Offset(0, 2).EntireColumn.NumberFormat = "General"
rnglog.Offset(0, 2).Value = "Week Number"
logrange.Offset(0, 3).FormulaR1C1 = "=TEXT(RC[-3],""mmmm"")"
logrange.Offset(0, 3).EntireColumn.NumberFormat = "General"
rnglog.Offset(0, 3).Value = "Month"
Set vlastrow = wb.Worksheets("Sheet1").Range("A:A").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set vlastcol = vlastrow.EntireRow.Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set copydata = .Range("A2", vlastcol)
copydata.Copy
End With
With ActiveWorkbook.Worksheets("RAW Data")
Set pastecell = .Range("A:A").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set callno = .Range("1:1").Find(What:="Call No", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
pastecell.Offset(1, 0).PasteSpecial xlPasteValues
.Cells.RemoveDuplicates Columns:=5, Header:=xlYes
Application.CutCopyMode = False
End With
wb.Close False
Application.ScreenUpdating = True
MsgBox "Done"
End If
End Sub
I thought I would get round the issue by closing the RAW Data workbook (I want to do this anyway) but I get a prompt as the clipboard data is rather large so this also doesn't work.
Since workbook wb
belongs to another application instance, you should use
wb.Application.CutCopyMode = False
instead
Application.CutCopyMode = False
where wb.Application
returns applications instance which workbook wb
belongs to.
What I do is just copy any blank cell in my ActiveWorkbook once I have pasted the values that I copied earlier and I don't need them any more - and this replaces the large data in the Clipboard with an empty string (comparatively nothing) and allows me to close the workbook when I need to.
I understand this is rather a workaround, but it works all the time.
Another Solution
What you should try is to get the MSForms DataObject
and try to put it in clipboard
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
and then clear it as following:
clipboard.Clear
And if this doesn't work, you can always set the clipboard text to empty
clipboard.SetText ""
clipboard.PutInClipboard
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With