Problems with ThisWorkbook when using Excel Add In - vba

I have the following lines of code that essentially copy and paste a sheet from one workbook into another:
Dim wb As Workbook, CopyFromWbk As Workbook, CopyToWbk As Workbook
Dim ShToCopy As Worksheet, targetSheet As Worksheet, sht As Worksheet
Dim Answer As VbMsgBoxResult
Answer = MsgBox("OPEN", vbOKCancel, "OPEN")
If Answer = vbCancel Then Exit Sub
Set wb = FileDialog_Open()
If wb Is Nothing Then End
Call Sheet_Selector
Set CopyFromWbk = wb
Set ShToCopy = CopyFromWbk.ActiveSheet
Set CopyToWbk = ThisWorkbook
ShToCopy.Cells.Copy
Set targetSheet =
CopyToWbk.Sheets.Add(After:=CopyToWbk.Sheets(CopyToWbk.Sheets.Count))
targetSheet.Range("A1").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
targetSheet.Name = "Sheet2"
CopyFromWbk.Close False
The problem is that when you use an Excel Add-In you have to be careful about using ThisWorkbook as it is actually addressing the Add In and not my workbook. I can't use "ActiveWorkbook" as it addresses the workbook I am copying from not copying to.
So I am struggling to figure out how to fix this. Note this code works perfectly when not used in the Excel Add In (due to the fact that I am using ThisWorkbook).
EDIT: All I had to do was move Set CopyToWbk = ActiveWorkbook to the top of the code and it worked of course.

Related

Export values not formulas with VBA

I am using the script below to export a worksheet as a CSV:
Sub Button14_Click()
'
' export Macro
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:M" & LR).SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:= _
"C:\upload\19meat-kl.csv" _
, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
I am a novice at VBA scripting and I actually got this code from another post.
For the most part it does what I want but if I try to use a formula it exports the formula rather than the result. What do I need to change so that the cell contents are what is exported?
Further to the comment by #Mat'sMug you need to use PasteSpecial xlValues and not just Paste.
Try this example code below - it does what your original macro does but with some best practices:
Use Option Explicit to prevent issues with badly defined variables
Set references to source data and target data e.g. source worksheet (wsSource), source range (rngToCopy), target workbook (wbTarget) and
target worksheet (wsTarget) - this is better than using ActiveSheet or Something.Select and so forth, which is not best practice
Do the paste immediately after the copy to prevent issues with clipboard persistence
Code:
Option Explicit
Sub SaveRangeDataAsValuesOnNewWorkbook()
' set-up your variables
Dim strFileToSave As String
Dim wsSource As Worksheet
Dim lngLastRow As Long
Dim wbTarget As Workbook
Dim wsTarget As Worksheet
Dim rngToCopy As Range
' where you want to save
strFileToSave = "C:\upload\19meat-kl.csv"
' get a worksheet reference
Set wsSource = ThisWorkbook.Worksheets("Sheet1") '<~~ set to your worksheet
' get last row in column A - you need to reference a worksheet to do this properly
lngLastRow = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
' now - add a workbook and get its reference
Set wbTarget = Application.Workbooks.Add
' get the first worksheet in the new workbook
Set wsTarget = wbTarget.Worksheets(1)
' get a reference to your source range
Set rngToCopy = wsSource.Range("A2:M" & lngLastRow).SpecialCells(xlCellTypeConstants, 23)
' copy the source range
rngToCopy.Copy
' paste it to the target worksheet in the new workbook - you need to PasteSpecial to a Range
wsTarget.Range("A1").PasteSpecial xlValues
' save the new workbook
wbTarget.SaveAs Filename:=strFileToSave, FileFormat:=xlCSV, CreateBackup:=False
' close the new workbook
Application.DisplayAlerts = False
wbTarget.Close
Application.DisplayAlerts = True
End Sub

Make macro run in specific workbook

This seems like such a simple request, but I can't seem to find any answers online.
I have two open workbooks (lets say A and B). All I want to do is run a macro that I have created in Workbook B and run it (by click a shape that I've assigned a macro to) through Workbook A, but the macro running in Workbook B
The macro I created for Workbook B is...
Sub HistoricalDataShift()
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate'
Rows("18:1000").Select
Selection.Copy
Range("A19").Select
ActiveSheet.Paste
Rows("15:15").Select
Selection.Copy
Range("A18").Select
ActiveSheet.Paste
Next ws
End Sub
Then I created a second macro in Workbook B that has...
Sub ApplicationRun()
Application.Run ("WorkbookB.xlsm!HistoricalDataShift")
End Sub
But each time I try the macro keeps running in Workbook A.
If I could get a helping hand that would be appreciated.
All you need to do is rewrite HistoricalDataShift to operate on itself. It should work just fine then.
Sub HistoricalDataShift()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
For Each ws In wb.Worksheets
ws.Activate '
ws.Rows("18:1000").Select
Selection.Copy
ws.Range("A19").Select
ActiveSheet.Paste
ws.Rows("15:15").Select
Selection.Copy
ws.Range("A18").Select
ActiveSheet.Paste
Next ws
End Sub
Also to make your code work better, you can do this:
Sub HistoricalDataShift()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Activate
Dim ws As Worksheet
For Each ws In wb.Worksheets
Call ws.Rows("18:1000").Copy(ws.Range("A19"))
Call ws.Rows("15:15").Copy(ws.Range("A18"))
Next ws
End Sub
Try declaring your workbook object?
Dim wkbkA as workbook
set wkbkA = 'directory here
then run your code in a With... End With
With wkbkA
.range('etc.........
End With
In this short example, we assume that WorkbookB.xlsm is initially the only open workbook and hosts this macro:
Sub HistoricalDataShift()
Dim wkbB As Workbook
Dim wkbA As Workbook
Set wkbB = ThisWorkbook
Workbooks.Open Filename:="WorkbookA"
Set wkbA = ActiveWorkbook
wkbA.Sheets(1).Range("B9").Value = "whatever"
End Sub
You can use Worksheets("<worksheetname>")
e.g. Worksheets("A").Activate
or cv = Worksheets(Worksheet).Cells(DataSeriesEnd, rc_index)
where Worksheet holds the sheet name.
etc.
This snippet will go through the entire collection of worksheets, where w is the current worksheet name :-
For Each w In Worksheets
.......
Next w

excel VBA error: The object invoked has disconnected from its clients

It seems a normal question and I have searched and tried many suggestions here but the error persists. I want to copy a "case1" sheet from current workbook to an existing workbook(file name is "workbook2.xlsx", it has a worksheet named "case2"), then save the workbook and close it. Sometimes it works well, but most of the time I kept getting the same error. In fact I did not change any code so I don't know where went wrong.
The error shows "The object invoked has disconnected from its clients". It always breaks in the same place:
ThisWorkbook.Sheets("case1").Copy Before:=ActiveWorkbook.Sheets("Case2")
Sub CopySheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'open existing "workbook2.xlsx"
Workbooks.Open filename:="c:\workbook2.xlsx"
'copy a sheet named "case1" from current workbook to "workbook2.xlsx" which already has a sheet named "case2"
ThisWorkbook.Sheets("case1").Copy Before:=ActiveWorkbook.Sheets("Case2")
'close "workbook2.xlsx"
Workbooks("workbook2.xlsx").Activate
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Always set references to sheets and workbooks, then there is no chance of confusing which is which. This code does the same thing and should not give you any errors.
Sub CopySheet()
Dim wb1 As Workbook, ws1 As Worksheet 'Source
Dim wb2 As Workbook, ws2 As Worksheet 'Target
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("case1")
Set wb2 = Workbooks.Open("c:\workbook2.xlsx")
Set ws2 = wb2.Sheets("case2")
ws1.Copy Before:=ws2
wb2.Close True
End Sub

Save values (not formulae) from a sheet to a new workbook?

I am using the following function to save a worksheet from a workbook and save it to a separate workbook. However, it is saving the formulas, whereas I would rather just the values end up in the final workbook. How can I modify this so the resultant workbook doesn't contain formulae and just values?
Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
.SaveAs FilePath
.Close False
End With
End Sub
Using the link kindly provided I tried this, but to no avail:
Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
Application.DisplayAlerts = False
.Worksheets(1).Delete
.Worksheets(1).Copy
.Worksheets(1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = True
.SaveAs FilePath
.Close False
End With
End Sub
but I get an error on the pastespecial line??
.Worksheets(1).Copy
This copies the sheet itself and does not relate to PasteSpecial. You could use:
.Worksheets(1).UsedRange.Copy
or similar. For example, Worksheets(1).Cells.Copy.
I assume it should be Worksheets(.Worksheets.Count) though.
In the following I am using SpecialCells to identify only the formulas in the worksheet, and setting rng.Value = rng.Value to convert these to the results of the formulas.
Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
Dim wb As Workbook
Dim ws As Worksheet
Dim rngFormulas As Range, rng As Range
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
Set ws = .Worksheets(.Worksheets.Count)
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
With ws
Set rngFormulas = ws.Cells.SpecialCells(xlCellTypeFormulas)
For Each rng In rngFormulas
rng.Value = rng.Value
Next rng
End With
.SaveAs FilePath
.Close False
End With
End Sub
You will need to add some error handling code, to handle the case where there are no formulas in the copied worksheet. (Array formulas may also need to be accounted for.)
The easiest way to copy the values is to do it in 2 steps:
Copy the sheet, then replace the formulas with their values
After:
.Worksheets(1).Delete
in your original code, add the lines:
With Range(Worksheets(.Worksheets.Count).UsedRange.Address)
.Value = .Value
End With
The .value=.value is telling excel to replace every value with the value that is currently being displayed, so all formulas will be replaced with their calculated value
Sorry, answer was starting to look a complete mess, so deleted it and started again. I've written this - it appears to work fine when I tested it - you just need an extra line to save any resulting spreadsheet. :)
For Each Cell In ActiveSheet.UsedRange.Cells
Cell.Copy
Cell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next

Copying range to new workbook

I have come across some code to copy a range to a new workbook, but I'm not sure why it works.
Worksheets("Short Form").Copy
Set wb = ActiveWorkbook
How does this copy the worksheet 'Short Form' to a new workbook when all that the code says is assign the active workbook to the reference 'wb'? It doesn't even employ the .add method. Right now I want to paste values only to this new workbook, but not quite sure how to do so because I don't understand this block of code.
Try this - as the following manual steps are the same as your code snippet:
1.Open a blank workbook
2.Press record macro
3.Right click the Sheet1 workbook tab
4.Select "Move or Copy"
5.In the "To book" combo select (new book)
6.Check the "Create a copy" box so that the window now looks like this:
7.Stop the recorder
8.Go and find your recorded code ...and voila....mine looks like this
Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
End Sub
Your code is the same as what these manual steps describe.
You must have a line Dim wb as workbook somewhere or it would not run.
This line Set wb = ActiveWorkbook will then make the object wb equal to the new workbook that you have copied into, as it is active, so you can do further operations on it. You can easily switch the workbook that wb is pointed at:
Sub Macro1()
Dim wb As Workbook
ThisWorkbook.Sheets("Sheet1").Copy
Set wb = ActiveWorkbook
MsgBox wb.Name
ThisWorkbook.Activate
Set wb = ActiveWorkbook
MsgBox wb.Name
End Sub
BUT
In my production code I generally never use Set x To ActiveWorkbook I always name the workbook and then use Set x To Workbooks("DefiniteName")
WITHOUT USING CLIPBOARD
If you want to avoid using the clip board then the following example shows how to move values-only data without using paste:
Sub WithoutPastespecial()
Dim firstRange As Range
Set firstRange = ThisWorkbook.Worksheets("Short Form").Range("S4:S2000") 'can change S4:S2000 to the range you want to copy
Dim newBk As Workbook
Dim secondRange As Range
Set newBk = Workbooks.Add
Set secondRange = newBk.Worksheets("Sheet1").Range("A1")
With firstRange
Set secondRange = secondRange.Resize(.Rows.Count, .Columns.Count)
End With
secondRange.Value = firstRange.Value
End Sub
Note this is not copying a Range rather the entire worskheet :)
If you use the method:
Worksheets("Short Form").Cells.Copy
Then you will copy only the cells, not the entire worksheet, and this method will NOT create a new workbook. You can tell it to add a workbook when necessary.
Here is an example:
Option Explicit
Sub CopyNew()
Dim wbNew As Workbook
Dim wb As Workbook
Set wb = ThisWorkbook 'It is a good idea to explicitly control workbooks using either a defined variable like "wb" or the "ThisWorkbook" object, instead of using "ActiveWorkbook" or referring to files by name.
Application.CutCopyMode = False
wb.Sheets("Short Form").Cells.Copy
'Add a new workbook for the values:
Set wbNew = Workbooks.Add
wbNew.Sheets(1).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub