I have an array loaded with cell addresses that are passsed into a sub that handles tab order on a sheet. I want to be able to put a control name, i.e. "MyListBox" in that array and have my function handle it. However, I cannot get it to resolve in the .activate method. If I implicitly name the control it will work but I need it to "macro expand / resolve" to the actual control name so I can say Array(x).Activate.
Here is the code I'm fumbling with to no avail. I've tried it with and without the MSFORMs declaration. I've tried concatenating the command "activesheet." & arr(x) and many other things. I'm pretty sure I'm probably missing something simple but can't seem to find it.
Sub TabIntercept()
Dim arr, a, x, nxt, sel
Dim cMyListBox As MSForms.ListBox
If TypeName(Selection) <> "Range" Then Exit Sub 'Exit if (eg) a shape is selected
Set sel = Selection.Cells(1) 'if multiple cells selected use the first...
arr = GetTabOrder(ActiveSheet.Name) 'this function loads the tab order from a table
If UBound(arr) = -1 Then
Application.OnKey "{TAB}"
Exit Sub
End If
For x = LBound(arr) To UBound(arr)
If Left(arr(x), 3) = "lst" Or Left(arr(x), 3) = "cmb" Then 'Look for a control - they all start with lst/cmb
Set cMyListBox = Sheets("Resources & Process").arr(x) 'HERE IS THE ISSUE
arr(x).Activate
End If
If sel.Address() = sel.Parent.Range(arr(x)).Address() Then
'loops back to start if at end...
nxt = IIf(x = UBound(arr), LBound(arr), x + 1)
sel.Parent.Range(arr(nxt)).Select
Exit For
End If
Next x
End Sub
Set cMyListBox = Sheets("Resources & Process").arr(x) 'HERE IS THE ISSUE
First, declare a Worksheet variable for that sheet; the Workbook.Sheets property returns an Object, so all these member calls are implicitly late-bound, and you're coding blindfolded without compiler assistance.
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Worksheets("Resources & Process")
Note the ActiveWorkbook qualifier: if you have a specific Workbook object to use instead, use that. But consider always qualifying Workbook member calls, otherwise you're implicitly referring to whatever the ActiveWorkbook is, and eventually that will not be the workbook you're expecting.
Now, sheet.arr(x) isn't going to work, as IntelliSense is now showing you when you type that . dot operator: a Worksheet object would have to expose an indexed property named arr for that to work.
What you want to do, is get the OLEObject that is named whatever the value of arr(x) is.
You get OLE objects from the Worksheet.OLEObjects property:
Dim oleControl As OLEObject
Set oleControl = sheet.OLEObjects(arr(x))
If that succeeds, you've found your MSForms control - but it's wrapped in an OLE object and we now just need to unwrap it:
Set cMyListBox = oleControl.Object
If that fails, then the MSForms control isn't compatible with the declared type of cMyListBox. But now you get IntelliSense and compile-time validation for member calls against it: if you type cMyListBox. and there's an Activate member, then the call should be valid at run-time.
Related
I want to update a line in my table based on a cell in another sheet, and to that end I intend to use the index match function. When I run the code below I get the error that it cannot get the property of the match function class.
What is the correct syntax in this regard?
Sub Update_Customer()
' Declarations
Dim rng as listobject
Dim wf as application.worksheetfunction
Dim cs_sht as string
Set rng = Sheets(1).ListObjects("Table_Customer")
Set ws = ThisWorkbook.ActiveSheet
cs_sht = ws.Name
' ERROR RUNNING THIS LINE vvvvv
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0)) = ws.Range("C_Firstname").Value
End Sub
Excel functions need to be nested, because a cell's value needs to be parsed as a single step.
VBA code doesn't need to do that. VBA instructions work best and are easier to debug when you split them and make them do as little work as possible.
So instead of this:
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0))
Split it up:
Dim matchResult As Long
matchResult = WorksheetFunction.Match(cs_sht, rng.ListColumns("Customer ID").DataBodyRange, 0)
Dim indexResult As Variant
indexResult = WorksheetFunction.Index(rng.ListColumns("FirstName").DataBodyRange, matchResult)
Note that you'll get a run-time error if either function fails to find what it's looking for. Use On Error to handle that case:
On Error GoTo CleanFail
Dim matchResult As Long
matchResult = WorksheetFunction.Match(...)
...
Exit Sub
CleanFail:
MsgBox "Could not find record for '" & cs_sht & "'." & vbNewLine & Err.Description
End Sub
Get rid of wf. There's no use to copy object references of objects that are already global. The fewer global variables you use, the better.
if the first name changes I can update the table to match the new name from my worksheet
You can't just assign the indexResult to a new value. The indexResult isn't holding a reference to any cell, it's just the result of the INDEX worksheet function. You need to use that result to get the cell you want to modify:
Dim targetCell As Range
Set targetCell = rng.ListColumns("FirstName").DataBodyRange.Cells(indexResult)
targetCell.Value = ws.Range("C_Firstname").Value
I am working on a quicker way to cycle through a column in a table in some previously written code. The problem I have is that at some point I need to assign the subject of the With statement (a single cell range) to an array of ranges, depending on the value of the range and nearby cells.
I have trimmed the code and taken only those bits which are necessary to the problem. See below:
Dim wb As Workbook
Dim wsFit As Worksheet
Dim fittingsTable As ListObject
ReDim fittings(0) As Range
Dim x As Integer
Dim y As Integer
Set wb = ActiveWorkbook
Set wsFit = wb.Worksheets("Fittings")
Set fittingsTable = wsFit.ListObjects("FittingsTable")
For x = 1 To fittingsTable.DataBodyRange.Rows.Count
With fittingsTable.DataBodyRange(x, 15)
If .Value <> vbNullString And .Value <> "0" Then
If .Offset(0, -2).Value <> "TBC" Then
'Do some stuff
Set fittings(y) = 'PROBLEM HERE
Else
'Do other stuff here
End If
End If
End With
Next
I want to assign fittingsTable.DataBodyRange(x, 15) to fittings(y), but I have no idea how to access the range that is the subject of the With statement.
I know that I could assign the desired range to another variable before the With statement begins, and then assign that variable to fittings(y) instead, but I feel like there must be a simple way to access the initial subject of the With statement so that I don't end up clogging my code with yet more variables. I could also use the .Address property to assign the range using the worksheet, but at this point I'm genuinely curious about finding a more direct way.
Your With block is holding a Range object reference.
You can use the .Cells (parameterless) property to retrieve a reference to that Range object:
Set fittings(y) = .Cells
Or, to make it more explicit that it's a single-cell range:
Set fittings(y) = .Cells(1, 1)
This makes an implicit default member call that ultimately ends up being equivalent to:
Set fittings(y) = .Item(1, 1)
That works for a Range. For a lot of other classes, there is no property that returns a reference to the object. For example, a Collection:
With New Collection
.Add 42
Set foo = ???? ' can't get a reference to the Collection object!
End With
The general solution is to extract the With block variable into a local variable, and now that variable is accessible just like any other local:
Dim c As Collection
Set c = New Collection
With c
.Add 42
Set foo = c
End With
For a custom class that you control, you can have a property getter that returns Me:
Public Property Get Self() As Class1
Set Self = Me
End Property
And now the With block variable is accessible through that property:
With New Class1
.Something = 42
Set foo = .Self
End With
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function
I am working on a userform trying to loop through the controls in a multipage.
The user form has 2 Multipages (MultiPage1 and MultiPage2).
Multipage2 is contained within the Multipage1.
When only MultiPage1 exists I could ran the following code:
For Each pPage In frmValidationTest.MultiPage1.Pages
But after creating this nested system, and I trying to run it again, displays the following error:
"Type Mismatch" (in the For Each pPage line)
The variable pPages is declared as follows:
Dim pPage as Page
I've ran Debug.Print Mode to check misspelling issues but everything is OK ("frmValidationTest.MultiPage1.Pages.Name" does actually print out an output)
When I take a look at the pPages, it declares that the variable is Nothing.
I just realized that when declaring the variable, I have 2 classes with the same name "Page".
Not sure what's going on, is that normal? I don't think I should have 2 different classes for the same superclass. (-F2- Ref Lib only shows 1).
After closing, restarting, etc. The issue still there.
Hopefully is just a minor thing!
Many thanks in advance.
There is a Page class in both the Excel and MSForms libraries. So you will be better off using the library names in your declarations. For example, if your form looks like this:
Then this code should work:
Option Explicit
Private Sub CommandButton1_Click()
' declare variables using specific libraries
Dim mpgItem1 As MSForms.MultiPage
Dim mpgItem2 As MSForms.MultiPage
Dim pagItem1 As MSForms.Page
Dim pagItem2 As MSForms.Page
' other variables
Dim ctlItem As Control
Dim intCounter1 As Integer
Dim intCounter2 As Integer
Dim intPageCount1 As Integer
Dim intPageCount2 As Integer
Set mpgItem1 = UserForm1.MultiPage1
' get page count of first multi page
intPageCount1 = mpgItem1.Pages.Count
' not using for..each loop ...
For intCounter1 = 0 To intPageCount1 - 1
Set pagItem1 = mpgItem1.Pages(intCounter1)
MsgBox pagItem1.Name
For Each ctlItem In pagItem1.Controls
' looking for nested multi page
If TypeName(ctlItem) = "MultiPage" Then
' same code as for first multipage
Set mpgItem2 = ctlItem
intPageCount2 = mpgItem2.Pages.Count
For intCounter2 = 0 To intPageCount2 - 1
Set pagItem2 = mpgItem2.Pages(intCounter2)
MsgBox pagItem2.Name
Next intCounter2
End If
Next ctlItem
Next intCounter1
End Sub
I have a dynamically defined named range in my excel ss that grabs data out of a table based on a start date and an end date like this
=OFFSET(Time!$A$1,IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),1,MATCH(Date_Range_End,AllDates)-IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),4)
But if the date range has no data in the table, the range doesn't exists (or something, idk). How can I write code in VBA to test if this range exists or not?
I have tried something like
If Not Range("DateRangeData") Is Nothing Then
but I get "Runtime error 1004, method 'Range' of object '_Global' failed."
Here is a function I knocked up to return whether a named range exists. It might help you out.
Function RangeExists(R As String) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = ActiveSheet.Range(R)
RangeExists = Err.Number = 0
End Function
You can replicate the match in your VBA to count before using the range how many rows you would have, or you can use error handling:
On Error Resume Next
Debug.Print range("DateRangeData").Rows.Count
If Err = 1004 Then
MsgBox "Range Empty"
Exit Sub
Else
MsgBox "Range full"
End If
Err.Clear
On Error GoTo 0
This is another approach. It has the advantage to take the container and the name you want to test. That means you can test either Sheets Names or Workbook Names for example.
Like this:
If NamedRangeExists(ActiveSheet.Names, "Date") Then
...
Else
...
End If
or
If NamedRangeExists(ActiveWorkbook.Names, "Date") Then
...
Else
...
End If
Public Function NamedRangeExists(ByRef Container As Object, item As String) As Boolean
Dim obj As Object
Dim value As Variant
On Error GoTo NamedRangeExistsError:
value = Container(item)
If Not InStr(1, CStr(value), "#REF!") > 0 Then
NamedRangeExists = True
End If
Exit Function
Exit Function
NamedRangeExistsError:
NamedRangeExists = False
End Function
Depending on the application you're doing, it's good to consider using a Dictionary. They're especially useful when you wanna check whether something exists.
Take this example:
Dim dictNames as Scripting.Dictionary
Sub CheckRangeWithDictionary()
Dim nm As Name
'Initially, check whether names dictionary has already been created
If Not dictNames Is Nothing Then
'if so, dictNames is set to nothing
Set dictNames = Nothing
End If
'Set to new dictionary and set compare mode to text
Set dictNames = New Scripting.Dictionary
dictNames.CompareMode = TextCompare
'For each Named Range
For Each nm In ThisWorkbook.Names
'Check if it refers to an existing cell (bad references point to "#REF!" errors)
If Not (Strings.Right(nm.RefersTo, 5) = "#REF!") Then
'Only in that case, create a Dictionary entry
'The key will be the name of the range and the item will be the address, worksheet included
dictNames(nm.Name) = nm.RefersTo
End If
Next
'You now have a dictionary of valid named ranges that can be checked
End Sub
Within your main procedure, all you need to do is do an existence check before using the range
Sub CopyRange_MyRange()
CheckRangeWithDictionary
If dictNames.exists("MyRange") then
Sheets(1).Range("MyRange").Copy
end if
End Sub
While loading the dictionary may look a little longer, it's extremely fast to process and search. It also becomes much simpler to check whether any named range referring to a valid address exists, without using error handlers in this simple application.
Please note that when using names at sheet level rather than workbook level, it is necessary to use more elaborate keys to guarantee uniqueness. From the way the dictionary was created, if a key is repeated, the item value is overwritten. That can be avoided by using the same Exists method as a check in the key creation statement. If you need a good reference on how to use dictionaries, use this one.
Good luck!
This is an old post, but none of the rated answers has a dynamic solution to test if a name exists in a workbook or worksheet. This function below will accomplish that:
Function pg_Any_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
pg_Any_Name = True
Exit Function
End If
Next n
End Function
Worth noting that this would not have worked for this specific question because OP had a dynamic defined range. This question would have been more accurately titled Test if Name is a Valid Range because the name always existed as a formula, the issue was if it was a valid RANGE. To address this question with a solution that checks both workbook and sheets... this function would work:
Function PG_Range_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
On Error Resume Next
PG_Range_Name = n.RefersToRange.Columns.Count > 0
Exit Function
End If
Next n
End Function