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
Related
I'm working on a macro which will run through the files in the folder and then copy sheets from all excel files to the workbook from which the macro was run.
This part works as charm, what I want to do is to select and copy sheets that match exact name.
For Each wksCurSheet In wbkSrcBook.Sheets
'I reckon I should add some if statement in here
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
Honestly, I have no idea how to write that statement, examples I found were quite confusing and when I try something by myself, I get weird errors.
If (wksCurSheet.Name == "AO-SC") Then
If (wksCurSheet.Name as String == "AO-SC") Then
If (wksCurSheet.("AO-SC")) Then
What's the correct way?
This is the way to get the specific worksheet through loop:
For Each wksCurSheet In wbkSrcBook.Worksheets
If wksCurSheet.Name = "AO-SC" Then
'Do something
End If
Next
This is how to use it with two worksheets:
If wksCurSheet.Name = "AO-SC" Or wksCurSheet.Name = "SomethingElse" Then
And if the worksheets, you are interestd in are saved in an array, you can use a custom function valueInArray, checking whether the worksheet's name is part of the predefined array:
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If CStr(myValue) = CStr(myArray(cnt)) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function
This is how to use it:
predefinedArrayWithNames = Array("Sheet1", "Sheet2","Sheet3")
If valueInArray(wksCurSheet.Name, predefinedArrayWithNames) Then
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
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.
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.
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