I know that it isn't possible to generate a control array at runtime.
However, is it possible to have several control arrays that I sub in at different points, referred to via a variable? IE
dim CArray() as controls
CArray = Labels
Foo(CArray)
CArray = OtherLabels
Foo(CArray)
My attempts to do this so far lead to a compile-time error, as it won't allow the control array actually on the form to be referred to without using a method or element. It gives the error:
Arugment not optional
You could use an object:
Private Sub Form_Load()
Dim CArray As Object
Set CArray = Labels
Foo CArray
End Sub
Sub Foo(CtrlArray As Object)
Dim i as Long
For i = 0 To CtrlArray.ubound
CtrlArray(i).Caption = Rnd
Next
End Sub
Related
I have a global array variable g () which starts with 3 object values.
I then call a sub that uses as input one of the items in g, and that needs to create additional items in g, plus update the item provided.
Something along the lines of
Declaration:
Public g() As branch
Initialization:
ReDim g (1 To 3)
Set g(1) = br1
Set g(2) = br2
Set g(3) = br3
Code call of sub
Call chg (g(2))
Sub
Public Sub chg (ByRef br As branch)
r = UBound(g)
ReDim g (1 To r + 2)
... (rest of the code)
End Sub
The code errors on the Redim statement, with error text "This array is fixed or temporarily locked".
Why can't I change the size of the array in this sub? What to do different?
From the MSDN documentation:
You tried to redimension a module-level dynamic array, in which one
element has been passed as an argument to a procedure. For example, in
the following code, ModArray is a dynamic, module-level array whose
forty-fifth element is being passed by reference to the Test procedure.
There is no need to pass an element of the module-level array in this
case, since it's visible within all procedures in the module. However,
if an element is passed, the array is locked to prevent a deallocation
of memory for the reference parameter within the procedure, causing
unpredictable behavior when the procedure returns.
Dim ModArray() As Integer ' Create a module-level dynamic array.
Sub AliasError()
ReDim ModArray(1 To 73) As Integer
Test ModArray(45) ' Pass an element of the module-level array to the Test procedure.
End Sub
Sub Test(SomeInt As Integer)
ReDim ModArray (1 To 40) As Integer ' Error occurs here.
End Sub
One idea would be to pass the index of the array instead of the object itself.
I've seen answers to questions similar to this one, but I haven't been able to find anything that addresses this exact situation.
Goal: Populate a list box and/or a worksheet with the output of a HypQueryMembers function. For example, I would like to get a list of the descendants of account 10100 without having to perform an ad hoc query and zoom in. I know how to get the return code, e.g. 0 if successful, but I want the actual output. I found some code that populated a list box, but I haven't been able to get it to work for me. I receive the error "Could not set the List property. Invalid property array index." My code follows:
Sub TestQueryMbrs()
Dim X As Integer
Dim arrAccounts
X = HypQueryMembers(Empty, "10100", HYP_DESCENDANTS, Empty, Empty, Empty, Empty, arrAccounts)
If X <> 0 Then
MsgBox "Unable to populate members." & vbCr & vbCr & "Error: " & X, vbCritical + vbOKOnly
Else
UserForm2.ListBox1.List = arrAccounts
UserForm2.Show
End If
End Sub
Any idea what I'm doing wrong? Also, I would like to accomplish the same thing, but populate a worksheet rather than a list box. But one step at a time!
Thanks!
Is 10100 the genuine name of the field? I suspect by you calling it account that 10100 should be replaced by Account instead as that parameter seems to be limited to the field name rather than an individual member. However, I have yet to determine how to get descendents of a particular account/cost centre so your way may be the correct way to do this.
I'd suggest trying that change to just "Account" though and then try adding as variant to Dim arrAccounts and then deleting Dim arrAccounts altogether if that doesn't work.
You may also not be able to populate the listbox before Userform2 is shown? You could wrap application.screenupdating =FALSE then TRUE around the Userform2 changes so the user doesn't see the list box being populated if there is a lag.
I had the same issue today and ran across this post - I realize it's years old...
Oracle's documentation on this function is a bit confusing... at least the example they used at the bottom of the page: https://docs.oracle.com/cd/E72988_01/DGSMV/ch12s15.html
For example, you need to enter the integer value for HYP_DESCENDANTS, which is 2 instead of the text shown in your code.
The following is a good snippet of code to verify your array:
Declare PtrSafe Function HypQueryMembers Lib "HsAddin" (ByVal vtSheetName As Variant, ByVal vtMemberName As Variant, ByVal vtPredicate As Variant, ByVal vtOption As Variant, ByVal vtDimensionName As Variant, ByVal vtInput1 As Variant, ByVal vtInput2 As Variant, ByRef vtMemberArray As Variant) As Long
Sub Example_HypQueryMembers()
sts = HypQueryMembers("INSERT WORKSHEET NAME HERE", "INSERT SMARTVIEW MEMBER HERE", 1, Empty, Empty, Empty, Empty, vArray)
If IsArray(vArray) Then
cbItems = UBound(vArray) + 1
MsgBox ("Number of elements = " + Str(cbItems))
For i = 0 To UBound(vArray)
MsgBox ("Member = " + vArray(i))
Next
Else
MsgBox ("Return Value = " + Str(vArray))
End If
End Sub
So I've seen a couple posts on this topic, but can't seem to find a way to get it to work. My goal is to create a Stacked Column Graph using VBA with the following characteristics:
Each column is based on data from a row (e.g. E6:P6, E7:P7, etc.).
Each "stack section" is each column in that row (located at E4:P4)
X Axes Labels are located in column A (e.g. A6, A7, etc.)
Y Axes Labels dynamic based on data (non specific).
Chart Title (which is the easy part - I got this).
Granted I also need the legend which shows the color key used by item 2.
This graph is one of three needed per report across 30+ reports that I generated via VBA from a raw data file. The last step to the reports is to make these graphs.
I am able to get stacked graph created, but the biggest problem is that as the data ranges above show, there are gaps in the data. This causes split sections in the graph as well as additional labels that I don't want. Essentially I don't know how to format the graph, and reading the Object Window that pops up from typing "ActiveChart." has only gotten me this far. If I know various formatting commands (alas I'm new to VBA with Excel), I can replicate it across all the charts that I need.
Dim data As Range
Set data = Range("A4:P12")
With Charts.Add
.ChartType = xlColumnStacked
.SetSourceData Source:=data, PlotBy:=xlColumns
.HasTitle = True
.ChartTitle.Text = "Weekly Report"
.Location Where:=xlLocationAsObject, Name:="Sheet1"
End With
Example of what I can make:
Output Graph
Side note about the blank data: The leftmost blank spot where a bar would be is the empty column D. Also I need to be able to edit the axes labels.
How about something like this:
Public Sub MakeGraph()
Dim ws As Excel.Worksheet
Dim data As Excel.Range
Dim x_axis_labels As Excel.Range
Dim series_names As Excel.Range
Dim sh As Excel.Shape
Dim ch As Excel.Chart
Dim I As Long
Set ws = Sheet1
Set data = ws.Range("E4:P12") ' Assumes the data are in E4:P12
Set x_axis_labels = ws.Range("A4:A12") ' Assumes the labels are in A4:A12
Set series_names = ws.Range("E2:P2") ' Assumes the labels are in E2:P2
Set sh = ws.Shapes.AddChart
Set ch = sh.Chart
With ch
.ChartType = xlColumnStacked
.SetSourceData Source:=data, PlotBy:=xlColumns
.HasTitle = True
.ChartTitle.Text = "Weekly Report"
.Axes(xlCategory, xlPrimary).CategoryNames = x_axis_labels
' Add series names
For I = 1 To .SeriesCollection.Count
.SeriesCollection(I).Name = series_names.Cells(1, I)
Next I
End With
Set ch = Nothing
Set sh = Nothing
Set series_names = Nothing
Set x_axis_labels = Nothing
Set data = Nothing
Set ws = Nothing
End Sub
Hope that helps
I take it your missing data would be a column in the range E6:P14? (I'm using E6:P14 because that's what you said first. Your code and #xidgel's later said E4:P12.)
Try this:
Sub MakeChart()
Dim rCats As Range
Dim rNames As Range
Dim rData As Range
Dim iCol As Long
Set rCats = ActiveSheet.Range("A6:A14")
Set rNames = ActiveSheet.Range("E4:P4")
Set rData = ActiveSheet.Range("E6:P14")
With ActiveSheet.Shapes.AddChart(xlColumnStacked).Chart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
For iCol = 1 To rData.Columns.Count
If WorksheetFunction.Count(rData.Columns(iCol)) > 0 Then
' it's not blank
With .SeriesCollection.NewSeries
.Values = rData.Columns(iCol)
.XValues = rCats
.Name = "=" & rNames.Cells(1, iCol).Address(, , , True)
End With
End If
Next
End With
End Sub
I am working with VBA in Excel to retrieve some information from the Reuters 3000 Database. The data I retrieve comes as a bidimensional array consisting of one column holding dates and other column holding numeric values.
After I retrieve the information, a process that takes no more than 2 seconds, I want to write this data to a worksheet. In the worksheet I have a column with dates and several other columns with numeric values, each column containing values of a same category. I iterate over the rows of the array to get the date and numeric value and I keep those in a variable, then I search for the date on the date column of the worksheet and after I've found the date I write the value. Here is my code:
Private Sub writeRetrievedData(retrievedData As Variant, dateColumnRange As String, columnOffset As Integer)
Dim element As Long: Dim startElement As Long: Dim endElement As Long
Dim instrumentDate As Variant: Dim instrumentValue As Variant
Dim c As Variant: Dim dateCellAddress As Variant
Application.ScreenUpdating = False
Sheets("Data").Activate
startElement = LBound(retrievedData, 1): endElement = UBound(retrievedData, 1)
Application.DisplayStatusBar = True
Application.StatusBar = "Busy writing data to worksheet"
For element = startElement To endElement
instrumentDate = retrievedData(element, 1): instrumentValue = retrievedData(element, 2)
Range(dateColumnRange).Select
Set c = Selection.Find(What:=instrumentDate, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
c.offset(0, columnOffset).Value = instrumentValue
End If
Next element
Application.DisplayStatusBar = False
End Sub
My problem is that this process is very slow, even if I have only 5 rows in the array it takes about 15 seconds to complete the task. As I want to repeat this process several times (once per each set of data I retrieve from the database), I would like to decrease the execution time as much as possible.
As you can see, I am disabling the update of the screen, which is one of the most recurrent actions to improve performance. Does anybody have a suggestion on how I can further decrease the execution time?
PS. I know the data retrieval process does not take much because I already tested that part (displaying values on a MsgBox as soon as the data has been retrieved)
Thanks in advanced.
This is what I did to improve the performance:
Avoid selecting the cell when the value is going to be written. This was a suggestion of Tim Williams.
I set the property Application.Calculation to xlCalculationManual
Instead of using the Find() function to search for the date, I loaded all the dates from the worksheet into an array and iterate over this array to get the row number. This turns out to be faster than the Find() function.
Private Function loadDateArray() As Variant
Dim Date_Arr() As Variant
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
End Function
Private Function getDateRow(dateArray As Variant, dateToLook As Variant)
Dim i As Double: Dim dateRow As Double
For i = LBound(dateArray, 1) To UBound(dateArray, 1)
If dateArray(i, 1) = dateToLook Then
dateRow = i
Exit For
End If
Next i
getDateRow = dateRow
End Function
Thank you all for your help!
By not selecting the sheet, you can add a bit more speed. Instead of
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
Try
With Sheets("Data")
Date_Arr = .Range(Cells(3, 106), Cells(3, 106).End(xlDown))
End With
If I have two variables containing binary values, how do I append them together as one binary value? For example, if I used WMI to read the registry of two REG_BINARY value, I then want to be able to concatenate the values.
VBScript complains of a type mismatch when you try to join with the '&' operator.
REG_BINARY value will be returned as an array of bytes. VBScript may reference an array of bytes in a variable and it may pass this array of bytes either as a variant to another function or as a reference to array of bytes. However VBScript itself can do nothing with the array.
You are going to need some other component to do some from of concatenation:-
Function ConcatByteArrays(ra, rb)
Dim oStream : Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1 'Binary'
oStream.Write ra
oStream.Write rb
oStream.Position = 0
ConcatByteArrays = oStream.Read(LenB(ra) + LenB(rb))
oStream.Close
End Function
In the above code I'm using the ADODB.Stream object which is ubiquitous on currently supported platforms.
If you actually had multiple arrays that you want to concatenate then you could use the following class:-
Class ByteArrayBuilder
Private moStream
Sub Class_Initialize()
Set moStream = CreateObject("ADODB.Stream")
moStream.Open
moStream.Type = 1
End Sub
Public Sub Append(rabyt)
moStream.Write rabyt
End Sub
Public Property Get Length
Length = moStream.Size
End Property
Public Function GetArray()
moStream.Position = 0
GetArray = moStream.Read(moStream.Size)
End Function
Sub Class_Terminate()
moStream.Close
End Sub
End Class
Call append as many times as you have arrays and retrieve the resulting array with GetArray.
For the record, I wanted VBScript code for a large userbase as a logon script that has the least chance of failing. I like the ADO objects, but there are so many mysterious ways ADO can be broken, so I shy away from ADODB.Stream.
Instead, I was able to write conversion code to convert binary to hex encoded strings. Then, to write back to a REG_BINARY value, I convert it to an array of integers and give it to the SetBinaryValue WMI method.
Note: WshShell can only handle REG_BINARY values containing 4 bytes, so it's unusable.
Thank you for the feedback.
Perhaps...
result = CStr(val1) & CStr(val2)