How to check if Excel sheet contains activeX control? - vba

I try to create a macro, placed in Workbook_Open() procedure, which adds items for combo boxes, named CBTask for each sheet in workbook, (which has combo box named CBTask in it).
Unfortunatelly following code generates Compile error: Method or data member not found"
I believe it is because not every sheet has CBTask in it (even on error resume next does not help).
Is there any way to check if sheet contains combo box, so I could do the checking before trying clear it, or adding new items?
Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer
Dim strTaskName As String
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
ws.CBTask.Clear
strTaskName = taskName(1)
Do
ws.CBTask.AddItem strTaskName
strTaskName = taskName(i)
i = i + 1
Loop While taskName <> "LastOne"
Next ws
On Error GoTo 0
End Sub
(as you can see, this code also uses additional function "taskName(intSubtaskValue as integer)" to convert integer to string (e.g. taksName(1) = "Task01", taskName(2) = "Task02...)

The Worksheet class doesn't have a member named CBTask which is why that code fails. I suggest you use the OLEObjects property instead:
ws.OLEObjects("CBTask").Object.Clear

To expand on Rory's answer, in addition to fully qualifying your objects, you can check if an ActiveX-control of a given name exists on a worksheet by using this function:
Function obj_exists(obj_name As String, on_worksheet As Worksheet) As Boolean
On Error GoTo errHandler
Debug.Print on_worksheet.OLEObjects(obj_name).Name
obj_exists = True
On Error GoTo 0
Exit Function
errHandler:
obj_exists = False
On Error GoTo 0
End Function

Related

Can I create a Jump table in VBA for Excel?

I wrote a simple translator / parser to process an EDI (830) document using multiple Select Case statements to determine the code to be executed. I’m opening a file in binary mode and splitting the document into individual lines, then each line is split into the various elements where the first element of every line has a unique segment identifier.
My code works perfectly as written. However, Select Case requires checking every Case until a match is found or the Case Else is executed. I’ve sequenced the Case statements in such a manner that the segments that appear most frequently (as in the case of loops), are placed first to minimize the number of "checks before code is actually executed.
Rather than using multiple Select Cases, I would prefer to determine an index for the segment identifier and simply call the appropriate routine using that index. I’ve used jump tables in C and Assembler and anticipated similar functionality may be possible in VBA.
You can do jump tables in VBA by using the Application.Run method to call the appropriate routine by name. The following code demonstrates how it works:
Public Sub JumpTableDemo()
Dim avarIdentifiers() As Variant
avarIdentifiers = Array("Segment1", "Segment2")
Dim varIdentifier As Variant
For Each varIdentifier In avarIdentifiers
Run "Do_" & varIdentifier
Next varIdentifier
End Sub
Public Sub Do_Segment1()
Debug.Print "Segment1"
End Sub
Public Sub Do_Segment2()
Debug.Print "Segment2"
End Sub
You can do this in Excel VBA, following the example below:
The example assumes you have split your EDI document into two columns, one with the 'processing instruction' and one with the data that instruction will process.
The jump table is to the right i.e. a distinct list of the 'processing instructions' plus a name of a Sub-routine to run for each instruction.
The code is:
Option Explicit
Sub JumpTable()
Dim wsf As WorksheetFunction
Dim ws As Worksheet
Dim rngData As Range '<-- data from your file
Dim rngCell As Range '<-- current "instruction"
Dim rngJump As Range '<-- table of values and sub to run for value
Dim strJumpSub As String
Dim strJumpData As String
Set wsf = Application.WorksheetFunction '<-- just a coding shortcut
Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
Set rngData = ws.Range("A2:A17") '<-- change to your range
Set rngJump = ws.Range("E2:F4") '<-- change to your circumstances
For Each rngCell In rngData
strJumpSub = wsf.VLookup(rngCell.Value, rngJump, 2, False) '<-- lookup the sub
strJumpData = rngCell.Offset(0, 1).Value '<-- get the data
Application.Run strJumpSub, strJumpData '<-- call the sub with the data
Next rngCell
End Sub
Sub do_foo(strData As String)
Debug.Print strData
End Sub
Sub do_bar(strData As String)
Debug.Print strData
End Sub
Sub do_baz(strData As String)
Debug.Print strData
End Sub
Make sure that you have written a Sub for each entry in the jump table.

Excel VBA Retrieve Constant from Worksheet Code Fails When New Code is Written

In an attempt to retrieve constants from each worksheet in some reporting workbooks I use, three years ago I wrote some code that gets included in each worksheet. Here's an example of the code:
Option Explicit
' Determine the type of worksheet
Private Const shtType As String = "CR"
Public Function GetShtType()
GetShtType = shtType
End Function
In other code that gets the values from the worksheets for processing, the following section of code is used, where 'wksToCheck' is the worksheet in question. This code is stored in a personal macro workbook, not in the workbook with the worksheet code:
' Get the sheet 'type' if it has one
On Error Resume Next
shtType = wksToCheck.GetShtType()
If Err.Number <> 0 Then
' We do not have a type
shtType = "Unknown"
Err.Clear
End If ' Err.Number...
On Error GoTo Error_BuildTemplateWbk
My problem is, I use the code above to process workbooks several times a week, and I have for the past three years. Now, I am trying to write some new code with the above block to process the report workbooks in a different way. However, when I run code with the above block now, I get a 'Method or Data Member Not Found' error on the '.GetShtType()' portion of the code. I cannot compile the code and of course, consequently, the code doesn't work. I have tried adding the worksheet code to a worksheet in the macro workbook to see if that would fix the problem. It hasn't. Does anyone have any ideas? I am running Excel 2013 on a Windows 7 PC. Any ideas?
Brian
Using late-binding, should avoid the error, Dim wksToCheck As Object, but you'll lose the intellisense.
If you're open to alternatives, you may have better luck simply using the CallByName function, or using worksheet's CustomProperties.
Using CallByName preserves backwards compatibility with your older workbooks if needed:
shtType = CallByName(wksToCheck, "GetShtType", VbMethod)
Or, using CustomProperties instead of a custom method, in your worksheets:
Private Sub Worksheet_Activate()
Const PropName$ = "ShtType"
Const ShtType$ = "CR"
On Error Resume Next
Me.CustomProperties(PropName) = ShtType$
If Err.Number = 13 Then
Me.CustomProperties.Add "PropName", ShtType
End If
End Sub
Then,
' Get the sheet 'type' if it has one
On Error Resume Next
shtType = wksToCheck.CustomProperties("ShtType")
If Err.Number = 13 Then
' We do not have a type
shtType = "Unknown"
Err.Clear
End If ' Err.Number...
On Error GoTo Error_BuildTemplateWbk

Error from passing workbook object to another function (Run-time "Automation error")

I have a set of functions that is meant to read data from various worksheets in a separate workbook. The main routine uses a loop to go through various sheet names and within the function two levels down, it looks into the workbook to grab data. I am getting runtime error '-2147023174' (800706ba) Automation error at various points in this function, and am wondering where the error lies.
Sub mainRoutine()
'opens workbook and runs makeFile function on a loop
Dim wbOBJ As Workbook, oFile As integer
Set wbOBJ = Workbooks.Open(filePath, ReadOnly:=True)
For k = 1 To 20
makeFile myBox.List(k), wbOBJ
Next k
wbOBJ.Saved = True
wbOBJ.Close
End Sub
Function makeFile(ShtName As String, ByRef wbOBJ as Workbook)
'calls various procedures from which to collect data
'and passes workbook object along
debug.print wbOBJ.Sheets(1).Cells(1,1).Value
printInfoA(ShtName)
printInfoB(ShtName, wbOBJ)
End Function
Function printInfoB(ShtName as String, ByRef wbOBJ as Workbook)
'assigns object to a sheet inside the other workbook, collects data
Dim wsOBJ As Worksheet
Set wsOBJ = wbOBJ.Sheets(ShtName)
For j = 1 to 10
Thisworkbook.Sheets(1).Cells(j,1) = wsObj.Cells(j, 1)
Next j
End Function
Even in the makeFile function, the error pops up on the debug.print line, even though the debug.print works, and produces the correct value.
If I suppress that line, the same error will instead occur in the mainRoutine on the wbOBJ.Saved = True line. What is causing these errors?
(Note that I originally tried to organize it this way, instead of having the workbook open and close everytime I ran the printInfoB function, as I am trying to increase speed.)

How to check the availability of a worksheet

I have to run a set of code related to worksheet "wins", but only if that worksheet exist.
Please share a code to check the availability of sheet "wins". If worksheet "wins" exist, then only I want to run that set of code, else I want to skip executing that set of code and move to next line of code.
You could use On Error Resume Next to skip the errror which occurs if you try access a not existing worksheet and assigning it to a object variable. So if the worksheet does not exist, no error occurs but the variable is Nothing. If the worksheet exists, then the variable is not Nothing.
Example:
Sub test()
Dim wsWins As Worksheet
On Error Resume Next
Set wsWins = ActiveWorkbook.Worksheets("wins")
On Error GoTo 0
If Not wsWins Is Nothing Then
MsgBox "Worksheet wins exists."
Else
MsgBox "Worksheet wins does not exist."
End If
End Sub
Axel's answer will work nicely. Some people prefer not to use error throwing to test if something exists. If you're one of them then I use the following quite a lot in a Utility module. It'll work for Worksheets, Charts, etc. (basically anything that's a collection with a 'Name' property):
Public Function ExcelObjectExists(testName As String, excelCollection As Object) As Boolean
Dim item As Object
On Error GoTo InvalidObject
For Each item In excelCollection
If item.Name = testName Then
ExcelObjectExists = True
Exit Function
End If
Next
ExcelObjectExists = False
Exit Function
InvalidObject:
MsgBox "Developer error: invalid collection object passed in ExcelObjectExists."
ExcelObjectExists = False
End Function
You can call it like this:
If ExcelObjectExists("wins", ThisWorkbook.Worksheets) Then

Get position (in number) of selected item in dropdown list

In a dropdown list I have a few items. Can I, when I select an item, get the position of that item in the list as a number?
If you are looking for the index of a Data Validation list, this is what I'd do:
Put the following code in the ThisWorkbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ValidationIndex As Long
Dim rngTest As Excel.Range
'assumes the data validation is in a cell named "rngTest"
On Error Resume Next
Set rngTest = Sh.Range("rngTest")
If rngTest Is Nothing Then
Exit Sub
End If
On Error GoTo 0
If Not Intersect(ActiveCell, Sh.Range("rngTest")) Is Nothing Then
ValidationIndex = GetValidationIndex
MsgBox ValidationIndex
End If
End Sub
Put this function in the ThisWorkbook module also, or else in any regular module:
Function GetValidationIndex() As Long
'returns a 1-based index
Dim rngTest As Excel.Range
Dim varValidationString As Variant
Dim ErrNumber As Long
Dim i As Long
With ActiveCell.Validation
If .Type = xlValidateList Then '3
On Error Resume Next
Set rngTest = ActiveCell.Parent.Range(.Formula1)
'I do this goofy thing with ErrNumber to keep my indenting and flow pretty
ErrNumber = Err.Number
On Error GoTo 0
'if the Validation is defined as a range
If ErrNumber = 0 Then
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
Exit Function
'if the validation is defined by comma-separated values
Else
varValidationString = Split(.Formula1, ",")
For i = LBound(varValidationString) To UBound(varValidationString)
If varValidationString(i) = ActiveCell.Value2 Then
GetValidationIndex = i + 1
Exit Function
End If
Next i
End If
End If
End With
End Function
If you are using a list or combo box, ListIndex would seem to be what you are after.
VB Help for ListIndex property: Returns or sets the index number of the currently selected item in a list box or combo box. Read/write Long. Remarks. You cannot use this property with multiselect list boxes.
If nothing is selected, ListIndex's value is -1. If memory serves, it is a zero based index.
ListIndex cannot be set at design time so it is not listed in the properties window.
When entering your code, type the list box name then dot and the editor displays all the available properties. Scroll down the list, note any that look interesting, then look them up.
I think it is not necessary to use a function. You can get it by using only Match function, like in above Doug's answer.
Dim GetValidationIndex as Integer
Dim rngTest as Range
' Get the validation list
With ActiveCell.Validation
Set rngTest = ActiveCell.Parent.Range(.Formula1)
end with
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
The function GetValidationIndex is good.
However, for some regional settings the line varValidationString = Split(.Formula1, ",") is not valid, because the character used to separate the different values is ";"
I suggest use:
varValidationString = Split(.Formula1, Application.International(xlListSeparator))