VBA Compile error inside if statement - vba

If IsArray(payCsv(pay_id)) = False Then
'create tempArray
lc = 0
Debug.Print "create array"
End If
If IsArray(payCsv(pay_id)) = True Then
Debug.Print " array exists, we should be able to get ubound"
lc = UBound(payCsv(0)) - LBound(payCsv(0))
l = l + 1
End If
I am using the above code to determine whether I can use Ubound on my 2D array (i.e. if the 2nd dimension is created, get length (ubound - lbound).
However, I am getting a compile error, even though condition 2 is false, it does not recognise that the code will not be relevant.
I am testing one array and the result is if I comment out "lc = UBound(payCsv(0)) - LBound(payCsv(0))" is "create array".
If I leave this line in there, I get the error "compile error - expected array"
Is this a bug in VBA?

If you want to access the UBound of the 2nd dimension of an array, the format goes like this:
UBound(payCSV, 2)
The MSDN page on this function may be helpful.
When you access payCSV(0) as you currently are, the code assumes that you want the 1st element within the 1st dimension of the payCSV array.
Perhaps you might want to try this?
If IsArray(payCsv(pay_id)) = False Then
'create tempArray
lc = 0
Debug.Print "create array"
Else
Debug.Print " array exists, we should be able to get ubound"
lc = UBound(payCsv, 2) - LBound(payCsv, 2)
l = l + 1
End If

Related

Nested dimensions in macro array argument

I am providing a multi-dimensional array to a macro in Word. Each element is an array, and each array element has 2 values, the name of an image and a short description. The macro is:
For i = LBound(figures, 1) To UBound(figures, 1)
cgmImage = "C:\path\to\images\" & figures(i, 0) & ".jpeg"
Selection.InlineShapes.AddPicture FileName:=cgmImage, LinkToFile:=False, SaveWithDocument:=True
Selection.TypeParagraph
With Selection
.Font.Size = 14
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.TypeText Text:=figures(i, 1)
End With
Next i
Sample input array would be:
[
['123','image 1'],
['456','image 2']
]
The macro works, inserting each image and its description. However I now want to add a third element, this element will itself be a 2D array representing a table. So input will look something like this:
[
[ '123','image 1', [['val1','val2'],['val3','val4']] ],
[ '456','image 2', [['val1','val2'],['val3','val4']] ]
]
In the macro I'll use this 3rd element to create a table. However, if I give input data like that into my original macro I now get a 'subscript out of range' error on this line:
cgmImage = "C:\path\to\images\" & figures(i, 0) & ".jpeg"
All I want to iterate is the first level of this whole data structure (e.g. for the sample data I provided above, 2 iterations). Even if I provide the 'dimension' attribute to LBound and UBound I still get the error, which shouldn't happen since the first element of the top level array elements are always just a string (the image file name). How can I achieve this? And will accessing the third element representing the table be along the lines of :figures(i,2,X,X)?
EDIT:
Array creation is in Python, just a standard list type. Calling of the macro is done using the mhammond pywin32 module here's a simplified version of the technique:
import win32com.client as win32
word = win32.gencache.EnsureDispatch("Word.Application")
template = word.Documents.Open("\path\to\file.docm")
word.Run("macroName",imagesArray)
Then I save and close it
if the inner most array is an array of array, then something like figures(i)(j)(k)(l) should be the way to go
you can use UBound(array,index) and LBound(array,index) functions to get the actual lower and upper array bounds of its index dimension
for example, along the lines of data you shown, you could consider the following code:
Option Explicit
Sub main()
Dim figures(1) As Variant
figures(0) = Array("123", "image 1", Array(Array("val1", "val2"), Array("val3", "val4"))) ' see how the innermost array is an array of arrays, too
figures(1) = Array("456", "image 2", Array(Array("val5", "val6"), Array("val7", "val8"))) ' see how the innermost array is an array of arrays, too
Dim i As Long, j As Long, k As Long, l As Long
For i = LBound(figures) To UBound(figures)
For j = LBound(figures(i)) To UBound(figures(i))
If IsArray(figures(i)(j)) Then
For k = LBound(figures(i)(j)) To UBound(figures(i)(j))
For l = LBound(figures(i)(j)(k)) To UBound(figures(i)(j)(k))
Debug.Print figures(i)(j)(k)(l)
Next
Next
Else
Debug.Print figures(i)(j)
End If
Next
Next
End Sub

Subscript out of range error in VBA?

I am trying to keep the values in the array. There is some 604 values it retrieves. This is giving me subscript out of range error. Can anyone help?
PlCounter = 1
ReDim PlArray(1 To PlCounter)
For Each plv In fs.PickListValues
Debug.Print "entered into loop"
Set pl = plv
Debug.Print pl.Value
If Len(pl.Value) = 0 Then
Debug.Print " The length is null ..so assigining null"
ReDim Preserve PlArray(1 To PlCounter)
PlArray(PlCounter) = "NULL"
PlCounter = PlCounter + 1
Else
Debug.Print " The length is not null ..so assigining vlaues"
ReDim Preserve PlArray(1 To PlCounter)
PlArray(PlCounter) = pl.Value
PlCounter = PlCounter + 1
End If
Next plv
End If
Next v1
Debug.Print "The final value of Plcoutner is "; PlCounter
Debug.Print "The Final Value of PlArray "; PlArray(PlCounter - 1) -- This is getting out of range error
I believe that you are trying to print PlArray(PlCounter - 1) when in fact your array goes from 1 to PlCounter, so in essence the debug print is trying to print PlArray(0) which is out of range.
You could fix this by replacing this line:
Debug.Print "The Final Value of PlArray "; PlArray(PlCounter - 1)
With something like this:
If PlCounter > 1 then Debug.Print "The Final Value of PlArray "; PlArray(PlCounter - 1)
If all you are trying to get out of the array is the upper-most value (as in, the value at the upper-most bound) then just use the property meant for that:
Debug.Print "The upper bound is "; Ubound(PlArray); "with a value of "; PlArray(Ubound(PlArray))
This ensures that you get the very last index of the array, regardless of how it is defined. This will also work if there is only one item in the array.
Likewise, you could use a similar operation when using Redim:
ReDim Preserve PlArray(LBound(PlArray) To UBound(PlArray) + 1)
This will help you avoid using that counter variable which will inevitably cause issues, especially since it is only being used to resize the array.
On a separate note, you may want to consider loading your range into an array in one shot. This will be faster to loop through as well (if you want to nullify what would otherwise be Empty for null cells).:
Dim Foo as Variant
Foo = SomeWorksheet.Range("A1:A100").Value
Keep in mind this will create a 2d array with a lower bound of 1 on both dimensions. So, if you need a 1d array, you must translate the items out of this array and into your 1d array.

Referencing value from Excel Listbox item in .Match function in VBA

I am hoping to use the string value of a selected Listbox item in a .Match function within VBA - I need the the value '1' to be entered into the row where the value of the selection matches a value in column "A:A", on a specific column.
What I thought I would be able to do is to use a .value argument for the selected ListBox item, however this seems to either error out or give me a Boolean response, which isn't what I am after (I am after the actual string value of the item).
I have already looped through all items to set the Selected argument to True, and then I am looping through the list one by one to add '1' to the correct range.
Here is the code I thought would work (but doesn't, it throws an error of "Run-time error '13': Type mismatch" which is presumably down to the .Value not being a String.
For x = 0 To Me.CreditsEmployeesListBox.ListCount - 1
Me.CreditsEmployeesListBox.Selected(x) = True
Next
For i = 0 To Me.CreditsEmployeesListBox.ListCount - 1
If Me.CreditsEmployeesListBox.Selected(i) = True Then
employeeRow = WorksheetFunction.Match(Me.CreditsEmployeesListBox(i).Value, IndexSheet.Range("A:A"), 0)
IndexSheet.Range(Cells(employeeRow, showCodeColumn).Address).Value = 1
End If
Next
It errors out on the 'employeeRow = ...' line. Here, I am essentially trying to ask it:
employeeRow = WorksheetFunction.Match(<value of the currently referenced ListBox item>,IndexSheet.Range("A:A"),0)
Is this possible with VBA or am I going about this the wrong way?
Thanks
Matt
As an "hybrid" answer (as there is more than one problem) try this:
For x = 0 To Me.CreditsEmployeesListBox.ListCount - 1
Me.CreditsEmployeesListBox.Selected(x) = True
Next
Dim employeeRow As Variant
For i = 0 To Me.CreditsEmployeesListBox.ListCount - 1
If Me.CreditsEmployeesListBox.Selected(i) = True Then
employeeRow = Application.Match(Me.CreditsEmployeesListBox.List(i), IndexSheet.Columns(1), 0)
If IsNumeric(employeeRow) Then IndexSheet.Cells(employeeRow, showCodeColumn).Value = 1
End If
Next
This also should avoid VBA-errors.
If any questions are left, just ask :)

Dealing with Empty Cells in VBA for Access

I have the following code which is supposed to step through an array of fields and create two new arrays to add to a new recordset:
For Each Field In SDSRecordsets(i)
Debug.Print (j)
Debug.Print (Field.Value)
fieldNames(j) = Field.Name
If Field.Value = Null Then
values(j) = ""
Else
values(j) = Field.Value
End If
j = j + 1
Next
The first time this loop runs, the Debug.Print lines print out 0 and then the string value in the first cell as it should. It then runs through the rest of it with no problems. The second time, it tries to add an empty cell. The first Debug.Print prints out 1, as it should, and the second prints out Null, also doing as it should. However, I then get a compile error on the line:
values(j) = Field.Value
Can anyone explain why it is reaching this line, because the way I see it, the If statement must be evaluating Null = Null as false for this to happen.
I've also tried doing this with:
If Not IsEmpty(Field.Value) Then
But that doesn't work either.
Use the Nz function:
For Each Field In SDSRecordsets(i)
Debug.Print (j)
Debug.Print (Field.Value)
fieldNames(j) = Field.Name
values(j) = nz(Field.Value,"")
j = j + 1
Next
Also you can use isnull([expr]) function, the direct comparison with null will not work

Keeping a count in a dictionary, bad result when running the code, good result adding inspections

Weird problem. Stepping through the code with inspections gives me correct answers. Just running it doesn't.
This program loops through each cell in a column, searching for a regex match. When it finds something, checks in a adjacent column to which group it belongs and keeps a count in a dictonary. Ex: Group3:7, Group5: 2, Group3:8
Just stepping through the code gives me incorrect results at the end, but adding and inspection for each known item in the dictionary does the trick. Using Debug.Print for each Dictionary(key) to check how many items I got in each loop also gives me a good output.
Correct // What really hapens after running the code
Group1:23 // Group1:23
Group3:21 // Group3:22
Group6:2 // Group6:2
Group7:3 // Group7:6
Group9:8 // Group9:8
Group11:1 // Group11:12
Group12:2 // Group12:21
Sub Proce()
Dim regEx As New VBScript_RegExp_55.RegExp
Dim matches
Dim Rango, RangoJulio, RangoAgosto As String
Dim DictContador As New Scripting.Dictionary
Dim j As Integer
Dim conteo As Integer
Dim Especialidad As String
regEx.Pattern = "cop|col"
regEx.Global = False 'True matches all occurances, False matches the first occurance
regEx.IgnoreCase = True
i = 3
conteo = 1
RangoJulio = "L3:L283"
RangoAgosto = "L3:L315"
Julio = Excel.ActiveWorkbook.Sheets("Julio")
Rango = RangoJulio
Julio.Activate
For Each celda In Julio.Range(Rango)
If regEx.Test(celda.Value) Then
Set matches = regEx.Execute(celda.Value)
For Each Match In matches
j = 13 'column M
Especialidad = Julio.Cells(i, j).Value
If (Not DictContador.Exists(Especialidad)) Then
Call DictContador.Add(Especialidad, conteo)
GoTo ContinueLoop
End If
conteo = DictContador(Especialidad)
conteo = CInt(conteo) + 1
DictContador(Especialidad) = conteo
Next
End If
ContinueLoop:
i = i + 1
'Debug.Print DictContador(key1)
'Debug.Print DictContador(key2)
'etc
Next
'Finally, write the results in another sheet.
End Sub
It's like VBA saying "I'm going to dupe you if I got a chance"
Thanks
Seems like your main loop can be reduced to this:
For Each celda In Julio.Range(Rango)
If regEx.Test(celda.Value) Then
Especialidad = celda.EntireRow.Cells(13).Value
'make sure the key exists: set initial count=0
If (Not DictContador.Exists(Especialidad)) Then _
DictContador.Add Especialidad, 0
'increment the count
DictContador(Especialidad) = DictContador(Especialidad) +1
End If
Next
You're getting different results stepping through the code because there's a bug/feature with dictionaries that if you inspect items using the watch or immediate window the items will be created if they don't already exist.
To see this put a break point at the first line under the variable declarations, press F5 to run to the break point, then in the immediate window type set DictContador = new Dictionary so the dictionary is initialised empty and add a watch for DictContador("a"). You will see "a" added as an item in the locals window.
Collections offer an alternative method that don't have this issue, they also show values rather than keys which may be more useful for debugging. On the other hand an Exists method is lacking so you would either need to add on error resume next and test for errors instead or add a custom collection class with an exists method added. There are trade-offs with both approaches.