Two issues - saving changes in an instantiated workbook, and activating other workbooks - vba

I have two spreadsheets; I'll call them spreadsheet 1 and spreadsheet 2. Spreadsheet one has a function which generates days of the month, and if it's at the end of the month, it is trying to call the module/sub in spreadsheet 2. This is to generate both "daily" reports and "monthly" reports.
At this point, there are two errors: the first is when I am trying to save the new instance of spreadsheet 2 that I created. The error is that it asks to save the workbook in a macro-free format. I simply want to save it! Not to make any changes to formatting. I am not even sure that it is trying to save changes to the instantiated book object.
the second is in spreadsheet 2, even though I set it to be active sheet (I think), the activesheet still comes up as the worksheet on spreadsheet 1 that runs the macro in the first place.
Any help is appreciated.
Option Explicit
Public Function LastWeekOfMonth() As Boolean
'finds the current date
Dim CurrentDate As Date
CurrentDate = CDate(ActiveSheet.Cells(FIRST_DATA_ROW, 1))
'find filepath and filename of the monthly documentation file
Dim mFilePath As String
Dim mFileName As String
mFilePath = "F:\Project Sweep\Kim Checklist\Barry Polinsky\Brathwaite, Tamika\"
mFileName = Cells(3, 4) & ".m_d.xlsm"
'if it is the last week of the month, write a monthly report, and return true to continue with the face to face paperwork
If (31 - Day(CurrentDate)) <= 7 Then
'write a monthly report
Dim app As New Excel.Application
Dim book As Excel.Workbook
' app.Visible = False 'Visible is False by default, so this isn't necessary
Set book = app.Workbooks.Add(mFilePath & mFileName)
'run the subroutine CheckSpreadsheet in module WriteReport in target book
app.Run "'" & mFilePath & mFileName & "'!" & "WriteReport" & ".CheckSpreadsheet", book
' CheckSpreadsheet (book)
'error next line
book.Save
book.Close
app.Quit
Set app = Nothing
LastWeekOfMonth = True
'if it is not, simply continue with the face to face paperwork
Else
LastWeekOfMonth = False
End If
End Function
In the target worksheet, in module WriteReport, subroutine CheckSpreadsheet, the following code is located.
Option Explicit
Public Sub CheckSpreadsheet(wbook As Excel.Workbook)
Set wosheet = wbook.Sheets("Monthly")
wosheet.Cells(5, 5) = "Hello world!"
End Sub

Don't need to have another instance of Excel, the property to hide a workbook is Windows, in order to hide the excel windows used by the workbook. Also bear in mind that a workbook can have more than one window.
If you are sure that the workbook you want to hide has only one window use this line:
Workbooks("WbkName").Windows(1).Visible = False
If the workbook has several windows use this procedure:
Sub Wbk_Hide()
Dim wbk As Workbook, wdw As Window
Set wbk = Workbooks("WbkName") 'Update as required
For Each wdw In wbk.Windows
wdw.Visible = False
Next
End Sub
I believe this changes the scope of your procedures, let me know otherwise.

Related

Excel VBA Application.CountIf() not working as in other macro

I am trying to use Application.CountIf() in an Excel macro and it is not returning a count. It returns the number as 0.
I find this confusing because I have used Application.CountIf() several times in another macro.
Working code from other macro:
Sub newer_COA()
Sheets("BATCH NUMBERS").Select
'Count total of column CO
count = Application.CountIf(Columns(93), "1")
End Sub
Code of new macro - sum_litres()
Sub sum_litres()
Workbooks("Small Fill.xlsm").Activate
Sheets("Small Fill").Select
'Count total Machine one entries in column F
Dim Machine_one_count As Integer
Machine_one_count = Application.CountIf(Columns(6), "1")
Workbooks("Small Fill Analysis.xlsm").Activate
Sheets("Sheet1").Select
Msg = Machine_one_count & " Number of entries from Machine one"
MsgBox Prompt:=Msg
End Sub
Output from new macro - sum_litres()
0 Number of entries from Machine one
I'm creating this new macro sum_litres() in a separate sheet called Small Fill Analysis which gets the sheet Small Fill.xlsm to look at the data. At the start of sum_litres() it uses the function below to check if the sheet Small Fill.xlsm is open and opens it successfully if the sheet is not already open. As this code works fine I didn't include it in my question above.
'Calls function IsWorkBookOpen() to check if the required spreadsheet is open
Ret = IsWorkBookOpen("Small Fill.xlsm")
If Ret = True Then
Workbooks("Small Fill.xlsm").Activate
Sheets("Small Fill").Select
Else
'Open required spreadsheet
Workbooks.Open FileName:="Small Fill.xlsm", ReadOnly:=True
Sheets("Small Fill").Select
End If
Function IsWorkBookOpen(ByVal FileName As String) As Boolean
Dim TargetWorkbook As Workbook
Dim IteratorWorkbook As Workbook
For Each IteratorWorkbook In Application.Workbooks
If IteratorWorkbook.FullName = FileName Then
Set TargetWorkbook = IteratorWorkbook
End If
Next
If Not TargetWorkbook Is Nothing Then
If TargetWorkbook.ReadOnly Then
IsWorkBookOpen = True
Exit Function
End If
End If
End Function
Many thanks for any suggestions!
I suspect the issue is the location of the macro but the solution is simply to not select things but refer to the ranges directly:
Sub sum_litres()
'Count total Machine one entries in column F
Dim Machine_one_count As Integer
Machine_one_count = Application.CountIf(Workbooks("Small Fill.xlsm").Sheets("Small Fill").Columns(6), "1")
Msg = Machine_one_count & " Number of entries from Machine one"
MsgBox Prompt:=Msg
End Sub

Determine if a VBComponent regards a workbook or a worksheet

The following code allows me to go through the workbook and worksheets that have macros:
For Each VBCmp In ActiveWorkbook.VBProject.VBComponents
Msgbox VBCmp.Name
Msgbox VBcmp.Type
Next VBCmp
As this page shows, for a workbook and a sheet, their type are both 100, ie, vbext_ct_Document. But I still want to distinguish them: I want to know which VBCmp is about a workbook, which one is about a worksheet.
Note that VBCmp.Name can be changed, they are not necessarily always ThisWorkbook or Sheet1, so it is not a reliable information for what I am after.
Does anyone know if there exists a property about that?
Worksheet objects and Workbook objects both have a CodeName property which will match the VBCmp.Name property, so you can compare the two for a match.
Sub Tester()
Dim vbcmp
For Each vbcmp In ActiveWorkbook.VBProject.VBComponents
Debug.Print vbcmp.Name, vbcmp.Type, _
IIf(vbcmp.Name = ActiveWorkbook.CodeName, "Workbook", "")
Next vbcmp
End Sub
This is the Function I'm using to deal with exported code (VBComponent's method) where I add a preffix to the name of the resulting file. I'm working on an application that will rewrite, among other statements, API Declares, from 32 to 64 bits. I'm planning to abandon XL 32 bits definitely. After exportation I know from where did the codes came from, so I'll rewrite them and put back on the Workbook.
Function fnGetDocumentTypePreffix(ByRef oVBComp As VBIDE.VBComponent) As String
'ALeXceL#Gmail.com
Dim strWB_Date1904 As String
Dim strWS_EnableCalculation As String
Dim strChrt_PlotBy As String
Dim strFRM_Cycle As String
On Error Resume Next
strWB_Date1904 = oVBComp.Properties("Date1904")
strWS_EnableCalculation = oVBComp.Properties("EnableCalculation")
strChrt_PlotBy = oVBComp.Properties("PlotBy")
strFRM_Cycle = oVBComp.Properties("Cycle")
If strWB_Date1904 <> "" Then
fnGetDocumentTypePreffix = "WB_"
ElseIf strWS_EnableCalculation <> "" Then
fnGetDocumentTypePreffix = "WS_"
ElseIf strChrt_PlotBy <> "" Then
fnGetDocumentTypePreffix = "CH_"
ElseIf strFRM_Cycle <> "" Then
fnGetDocumentTypePreffix = "FR_"
Else
Stop 'This isn't expected to happen...
End If
End Function

How can I pick values from an Excel workbook and return them by function on active workbook

My goal is to implement some of functions where I give them parameters of power, frequency and speed of an electric motor, and look in another workbook (in which I have motor data) and return the size, shaft diameter and other motor details.
As I have not mastered much VBA I tried to implement a function that simply goes to a cell in another workbook and returns the value:
Function Test() As String
Dim name As String
With Workbooks.Open("D:\ExcelTest\WbSource.xlsm").Sheets("Sheet1")
name = .Cells(2, 3)
End With
Test= name
ActiveWorkbook.Save
ActiveWorkbook.Close
End Function
The problem is that it gives me a #VALUE! error, but each variable used is defined as a string and the cells has general format (if I change cells format to text it gives me the same message).
Try as I might, I could not get workbooks.open to work in a function, even if the function calls a sub. You could open the catalogue file in the workbook open event, and close it again in the before close event.
In the VProject Explorer, right click on "ThisWorkBook," and "View code".
In the pick list at the top, select Workbook, and the sub Workbook_open() procedure should be created. If not, select "Open" in the right pick list. Put in the following:
Application.Workbooks.Open ("D:\ExcelTest\WbSource.xlsm")
ThisWorkbook.Activate 'restores the "focus" to your worksheet
Then click the right pick list and select "beforeClose" and put in
On Error Resume Next 'this keeps it from crashing if the catalogue is closed first
Workbooks("WbSource.xlsm").Close
As long as the worksheet opens the wbsource file first, the function will work.
Here is an approach with scheduling UDF execution in queue, and processing outside UDF that allows to get rid of UDF limitations. So the value from the closed workbook got via ExecuteExcel4Macro() by a link.
Put the following code into one of the VBAProject Modules:
Public Queue, QueueingAllowed, UDFRetValue
Function UDF(ParamArray Args())
If IsEmpty(Queue) Then
Set Queue = CreateObject("Scripting.Dictionary")
UDFRetValue = ""
QueueingAllowed = True
End If
If QueueingAllowed Then Queue.Add Application.Caller, (Args)
UDF = UDFRetValue
End Function
Function Process(Args)
If UBound(Args) <> 4 Then
Process = "Wrong args number"
Else
' Args(0) - path to the workbook
' Args(1) - filename
' Args(2) - sheetname
' Args(3) - row
' Args(4) - column
On Error Resume Next
Process = ExecuteExcel4Macro("'" & Args(0) & "[" & Args(1) & "]" & Args(2) & "'!R" & Args(3) & "C" & Args(4))
End If
End Function
Put the following code into ThisWorkbook section of VBAProject Excel Objects:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim Item, TempFormula
If Not IsEmpty(Queue) Then
Application.EnableEvents = False
QueueingAllowed = False
For Each Item In Queue
TempFormula = Item.FormulaR1C1
UDFRetValue = Process(Queue(Item))
Item.FormulaR1C1 = TempFormula
Queue.Remove Item
Next
Application.EnableEvents = True
UDFRetValue = ""
QueueingAllowed = True
End If
End Sub
After that you can get the values from closed workbook via worksheet formula using UDF:
=UDF("D:\ExcelTest\";"WbSource.xlsm";"Sheet1";2;3)
Anyway you can add Workbooks.Open() or any other stuff into Function Process(Args) to make it to work the way you want. The code above is just an example.
I've answered the similar questions here and here, so that descriptions might be helpful.
I suggest:
open WbSource.xlsm either manually or via VBA outside the UDF.
pass the parameters to the UDF
have the UDF search down the columns of the newly opened workbook to find the correct record
have the UDF pass the row number back to the worksheet
in the worksheet, use Match()/Index() formulas to retrieve other data.

Updating target workbook - extracting data from source workbook

My question is as follows:
I have given a workbook to multiple people. They have this workbook in a folder of their choice. The workbook name is the same for all people, but folder locations vary.
Let's assume the common file name is MyData-1.xls.
Now I have updated the workbook and want to give it to these people. However when they receive the new one (let's call it MyData-2.xls) I want specific parts of their data pulled from their file (MyData-1) and automatically put into the new one provided (MyData-2).
The columns and cells to be copied/imported are identical for both workbooks. Let's assume I want to import cell data (values only) from MyData-1.xls, Sheet 1, cells B8 through C25 ... to ... the same location in the MyData-2.xls workbook. How can I specify in code (possibly attached to a macro driven import data now button) that I want this data brought into this new workbook. I have tried it at my own location by opening the two workbooks and using the copy/paste-special with links process. It works really well, but It seems to create a hard link between the two physical workbooks. I changed the name of the source workbook and it still worked. This makes me believe that there is a "hard link" between the tow and that this will not allow me to give the target (MyData-2.xls) workbook to others and have it find their source workbook.
To clarify my understanding, each user has a spreadsheet called MyData-1.xls but with varying locations. You would like to send each person a new spreadsheet MyData-2 which will automatically pull in data from range B8:C25 in MyData-1.xls?
There are various options on doing this and below I have provided one way of doing this. In short, the user will open MyData-2, click a button, and the code will search for MyData-1 on their directory, open the workbook, grab the data, paste it into MyData-2, and then close MyData-1.
Sub UpdateWorkbook()
'Identify workbook you would like to pull data from (same for all users)
Dim TargetWorkbook As String
TargetWorkbook = "MyData-1"
'Get the full path of that workbook by searching in a specified directory
Dim TargetPathName As String
TargetPathName = GetFilePath(TargetWorkbook)
'Retrieve data in range B8:C25, copy and paste, then close workbook
Dim TargetRng As Range
Application.ScreenUpdating = False
Workbooks.Open Filename:=TargetPathName
Set TargetRng = Sheets("Sheet1").Range("B8:C25")
TargetRng.Copy Destination:=ThisWorkbook.Worksheets(1).Range("B8:C25")
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Function GetFilePath(TargetWkbook As String) As String
Dim FullFilePath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = "C:\"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
.Filename = TargetWkbook
If .Execute > 0 Then
FullFilePath = .FoundFiles(1)
End If
End With
GetFilePath = FullFilePath
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Function
By way of explanation:
In the sub you first need to specify the name of the workbook MyData-1
The Function GetFilePath will then get the full path name of the workbbok. Note that I have set it to look in the "C:\" drive and you may want to amend that
Once we have the full file path we can easily open the workbook and copy the required range.
Note that the screenupdating is turned off to create the 'illusion' that the workbook has not been opened when the data is copied. Also, I have added a button on the worksheet of MyData-2 to trigger the code i.e. user opens workbook, presses button, and data is imported.
Finally, this code could be augmented significantly and you may want to tweak it. For example, error checking if file not found, searching in multiple directories (e.g C:\, D:)...
Hope this gets you started on the right track
You should use the copy/paste-special for values only:
Private Sub ImportData_Click()
On Error GoTo OpenTheSheet
Workbooks("MyData-1.xls").Activate
GoTo SheetOpen
OpenTheSheet:
Workbooks.Open "MyData-1.xls"
Workbooks("MyData-1.xls").Activate
SheetOpen:
On Error GoTo 0
Workbooks("MyData-1.xls").Worksheets("sheetwhatever").firstRange.Copy
Workbooks("MyData-2.xls").Worksheets("anothersheet").yourRange.PasteSpecial(xlPasteValues)
End Sub
This could be cleaned up a bit, but it's always messy to do file stuff in VBA, I'd probably put the opening code in a function.
Make sure they put the new file in the same directory as the old file.

How to test for existence of VBA in Excel workbook, in VBA?

I am writing a reporting tool to document Excel files for various "compliance criteria", including wkb.VBProject.Protection to report if the VBA is locked.
But how can I find if the workbook HAS any project ?
If I calculate
wkb.VBProject.VBComponents.Count - wkb.Worksheets.Count - 1 '(for the workbook)
that will give me the number of modules + class modules + forms, but I could still have some code behind a sheet.
Is there a way in Excel - like Access frm.HasModule - to find out if there's any VBA code in the workbook ?
Excel 2007+ has a new workbook property called ".HasVBProject" that you can enquire.
For Excel 2003 and earlier the above solution testing for lines of code in the CodeModule of any of the VBComponents of the workbook is appropriate.
You should test the ".CountOfLines" property all alone, since lines of code in the Declaration section of a code module (obtained via ".CountOfDeclarationLines") are considered by Excel as "Macro code" and require saving to macro-enabled formats.
Public Function HasVBProject(Optional pWorkbook As Workbook) As Boolean
'
' Checks if the workbook contains a VBProject.
'
On Error Resume Next
Dim wWorkbook As Workbook
Dim wVBComponent As VBIDE.VBComponent ' As Object if used with Late Binding
' Default.
'
HasVBProject = False
' Use a specific workbook if specified, otherwise use current.
'
If pWorkbook Is Nothing _
Then Set wWorkbook = ActiveWorkbook _
Else Set wWorkbook = pWorkbook
If wWorkbook Is Nothing Then GoTo EndFunction
If (VBA.CInt(Application.Version) >= 12) _
Then
' The next method only works for Excel 2007+
'
HasVBProject = wWorkbook.HasVBProject
Else
' Signs the workbook has a VBProject is code in any of the VBComponents that make up this workbook.
'
For Each wVBComponent In wWorkbook.VBProject.VBComponents
If (wVBComponent.CodeModule.CountOfLines > 0) _
Then
' Found a sign of programmer's activity. Mark and quit.
'
HasVBProject = True: Exit For
End If
Next wVBComponent
End If
EndFunction:
Set wVBComponent = Nothing
Set wWorkbook = Nothing
End Function
Dutch
I've used the following to count the total number of lines in a project before. It will pick up code in ThisWorkbook, code modules, class modules and forms.
Private Sub countCodeLines()
Dim obj As Object
Dim VBALineCount As Long
For Each obj In ThisWorkbook.VBProject.VBComponents
VBALineCount = VBALineCount + obj.CodeModule.CountOfLines
Next obj
Debug.Print VBALineCount
End Sub
Note however that if your workbooks have Option Explicit forced then this will count as two lines per object (Option Explicit and a line feed). If you know this to be the case, and are checking the LOC from another project, then you could simply count the number of objects, double it and test that VBALineCount does not exceed this number.
After Lunatik's hint, here's my final function (for whom it may help):
Function fTest4Code(wkb As Workbook) As Boolean
'returns true if wkb contains VBA code, false otherwise
Dim obj As Object
Dim iCount As Integer
For Each obj In wkb.VBProject.VBComponents
With obj.CodeModule
'# lines - # declaration lines > 2 means we do have code
iCount = iCount + ((.CountOfLines - .CountOfDeclarationLines) > 2)
End With
If iCount 0 Then Exit For 'stop when 1st found
Next obj
fTest4Code = CBool(iCount)
End Function