Why am I getting a "Subscript is out of range" error? - vba

I have the following code that is within a UserForm, called near the end of a bunch of other processes in the main module, but when it reaches Me.GPListBox.List(iterI, 0) = Split (CCGPValues(key), " - ")(0) I get an error stating the subscript is out of range.
In the Debug.Print directly before the For Each, the console outputs "Jorge Cardona". This is the first piece of the split. CCGPValues(key) equals "Jorge Cardona - $207.31", but when it calls the same split within the GPListBox, it breaks. Why is this happening when it works via Debug.print?
Dim key As Variant, iterI As Integer, iterX As Integer
Debug.Print Split(CCGPValues(147), " - ")(0)
For Each key1 In CCGPValues.Keys
Me.GPListBox.AddItem
Me.GPListBox.List(iterI, 0) = Split(CCGPValues(key), " - ")(0) 'Breaks here
Me.GPListBox.List(iterI, 1) = Split(CCGPValues(key), " - ")(1)
CCGPValuesCount = CCGPValuesCount + 1
iterI = iterI + 1
Next key1

You are running loop on Key1 in For Each key1 In CCGPValues.Keys and for the split part you are passing key in = Split(CCGPValues(key), " - ")(0)
So there is nothing to split and hence the resulting array is not initialized. Then from a blank array, you are trying to read first element. So the sub script error.
Option Explicit avoids these kind of headaches.

Related

SSRS Distinct LookupSet Issue

I apologize for the long post but I'm losing my mind here. I've tried looking this up but I keep getting error messages on any suggested fixes on this thread:
SSRS distinct lookupset function
I've even tried to completely recreate a similar data set in that question but keep getting issues.
This is the data set I created.
Using this in the expression box, and grouping by itemID, rackID, UseByDate
Join(LookupSet(Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value
, Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value
, Fields!CustomerSeqNo.Value
, "PickingList"), ",")
I get
but I would like to remove the duplicates in the LookupSet so it would just display "1".
I tried the first 2 options in that link above but they both provided an error message:
Public Shared Function RemoveDuplicates(m_Array As Object()) As String()
System.Array.Sort(m_Array)
Dim k As Integer = 0
For i As Integer = 0 To m_Array.Length - 1
If i > 0 AndAlso m_Array(i).Equals(m_Array(i - 1)) Then
Continue For
End If
m_Array(k) = m_Array(i)
k += 1
Next
Dim unique As [String]() = New [String](k - 1) {}
System.Array.Copy(m_Array, 0, unique, 0, k)
Return unique
End Function
with this expression:
=Join(Code.RemoveDuplicates(LookupSet(Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value
, Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value
, Fields!CustomerSeqNo.Value
, "PickingList")), ",")
returns this warning:
[rsRuntimeErrorInExpression] The Value expression for the textrun 'CustomerSeqNo.Paragraphs[0].TextRuns[0]' contains an error: Operator '&' is not defined for type 'Integer' and type 'CalculatedFieldWrapperImpl'. and this error
The other solution doesn't even deploy. Any help here?
Luckily for you #JMG, I just had to do this for a customer!
Here's the function:
public function DistinctValues(input() as Object) as string
dim newList as String
for each n as string in input
if InStr(newList, cstr(n) + ", ") = false
newList += cstr(n) + ", "
end if
next
return left(newList, len(newList) -2)
end function
So what it's doing is parsing through each value in the array. We are going to insert each unique value into a comma delimited string. Before doing so, we just check the string with InStr to see if that value already exists.
Make sure you cast the return value to string via CSTR(Fields!CustomerSeqNo.Value) to avoid any datatype issues. Your code should look something like this.
Code.DistinctValues(LookupSet(Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value, Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value, CSTR(Fields!CustomerSeqNo.Value), "PickingList"))

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.

VBA Compile error inside if statement

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

Type mismatch in for loop including tests of worksheet cell values

I am receiving a type mismatch error in my VBA macro. Here is the essential part of my code:
Public Function CalculateSum(codes As Collection, ws As Worksheet) As Double
On Error GoTo ErrorHandler
If ws Is Nothing Then
MsgBox ("Worksheet is necessery")
Exit Function
End If
Dim balanceColumnIndex, codesCulumnIndex As Integer
Dim searchStartRow, searchEndRow As Integer
balanceColumnIndex = 17
codesColumnIndex = 4
searchStartRow = 7
searchEndRow = ws.Cells(ws.Rows.Count, codesColumnIndex).End(xlUp).Row
Dim result As Double
result = 0#
For counter = searchStartRow To searchEndRow
If Len(ws.Cells(counter, codesColumnIndex)) > 0 And Len(ws.Cells(counter, balanceColumnIndex)) > 0 And _
IsNumeric(ws.Cells(counter, codesColumnIndex).Value) And IsNumeric(ws.Cells(counter, balanceColumnIndex).Value) Then
If Contains(codes, CLng(ws.Cells(counter, codesColumnIndex).Value)) Then
result = result + ws.Cells(counter, balanceColumnIndex).Value
''' ^^^ This line throws a type-mismatch error
End If
End If
Next counter
CalculateSum = result
ErrorHandler:
Debug.Print ("counter: " & counter & "\ncode: " & ws.Cells(counter, codesColumnIndex).Value & "\namount: " & ws.Cells(counter, balanceColumnIndex).Value)
End Function
Now what happens is that a type-mismatch error occures on the line where current row balance is added to result even though:
searchEndRow equals 129, and somehow counter equals 130
cells under current address are empty, yet somehow they pass test for length and numeric values (I stopped to debug at this point, IsNumeric(ws.Cells(counter, codesColumnIndex).Value) returns true!
Now I am simply confused and I don't know what to do. Please help.
As commenters have noted, Cells(...).Value is a Variant. This means that operators may not apply to .Value the way you expect. For tests using Len or other string operations, expressly convert to a string. For example, instead of Len(ws.Cells(...)), try Len(CStr(ws.Cells(...).Value)). That way you will know that Len is giving you the result you expect.
Similarly, where you add to result, use result = result + CDbl(ws.Cells(...).Value) to make sure you are adding Double values together.
To answer your question regarding errors that happen differently on different computers, what I have most often experienced is that it is the specific data in question. As one of the commenters pointed out, Empty is indeed numeric since it implicitly converts to 0! As a result, IsNumeric(Empty) is True. Using CStr guards against that in your code because IsNumeric(CStr(Empty)) = IsNumeric("") = False. Using IsNumeric(CStr(...)) prevents you from trying to add 0# + "", which is a type mismatch. So perhaps the user has an empty cell that you don't have in your test data, and that's causing the problem. That's not the only possibility, just the one I have encountered most.

How do I program a loop into a DDEPoke call on VBA?

I am attempting to program a loop into a DDEPoke call to a VBA-supported function known as OPC. This will enable me to write to a PLC (RSLogix 500) database from an excel spreadsheet.
This is the code:
Private Function Open_RsLinx()
On Error Resume Next
Open_RsLinx = DDEInitiate(RsLinx, C1)
If Err.Number <> 0 Then
MsgBox "Error Connecting to topic", vbExclamation, "Error"
OpenRSLinx = 0 'Return false if there was an error
End If
End Function
Sub CommandButton1_Click()
RsLinx = Open_RsLinx()
For i = 0 To 255
DDEPoke RsLinx, "N16:0", Cells(1 + i, 2)
Next i
DDETerminate RsLinx
End Sub
This code works and will, if there is a link set up with an OPC server (in this case through RSLinx) write data to the PLC.
The problem is that I can't get the part DDEPoke RsLinx, "N16:0", Cells(1 + i, 2) to write data, sequentially, from one excel cell to one element of the PLC's data array.
I tried to do DDEPoke RsLinx, "N16:i", Cells(1 + i, 2) and DDEPoke RsLinx, "N16:0+i", Cells(1 + i, 2) but neither has any effect and the program doesn't write anything at all.
How can I set up the code to get N16:0 to increment all the way up to N16:255 and then stop?
Break the variable i out of the string. Be careful for the implicit type conversion though, depending on which (Str() or CStr()), you'll wind up with a leading space. Thus, convert the number Str(i), then wrap with Trim() to make sure there's no extra spaces, and concatenate that result back to your "N" string:
RsLinx = Open_RsLinx()
For i = 0 To 255
DDEPoke RsLinx, "N16:" & Trim(Str(i)), Cells(1 + i, 2)
Next i
The reason the i didn't work when it's inside the string is because that in VBA, anything within a set of quotes is considered a literal string. Unlike some other languages (PHP comes to mind) where variables can be resolved within a string like that, VBA must have variables concatenated. Consider the following:
Dim s As String
s = "world"
Debug.Print "Hello s!"
This outputs the literal of Hello s! to the immediate window, because s is treated not as a variable, but as part of the literal string. The correct way is through concatenation:
Dim s As String
s = "world"
Debug.Print "Hello " & s & "!"
That outputs the expected Hello World! to the immediate window, because s is now treated as a variable and is resolved and concatenated.
If that were not the case, the following might be difficult to deal with:
Dim i As Integer
For i = 0 to 9
Debug.Print "this" & i
Next i
You would then have:
th0s0
th1s1
th2s2
th3s3
th4s4
'etc
That'd make things pretty difficult to manage in a lot of cases.
With all that said, there are some languages - notably PHP - where, when using a certain set of quotes (either "" or '' - I don't recall which offhand), in fact does resolve the variable when embedded into the string itself:
$i = 5;
echo "this is number $i";
VBA does not have this feature.
Hope it helps...