Excel VBA - listbox.selected property causing error - vba

I'm developing a program within Excel and VBA, and am getting a run time error 380 when I try to change the selected property of a listbox.
The property is determined by a column on an excel spreadsheet, containing True or False values. I've printed the contents of these cells to the console and can confirm that the true/false values are working correctly, however when I try to assign these values to my listbox.selected property I get an error.
The function is below, any help or suggestions would be much appreciated.Error occurs on this line:
ElementListBox.Selected(count - 1) = TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Included)).Value
Public Function LoadTier2SubTaskList(ByVal Task As Single, ByRef ElementListBox As Control)
ElementListBox.Clear
WorklistComboBox.Clear
Dim count As Single
Dim finished As Boolean
Dim TaskListSheet As Worksheet
Set TaskListSheet = TBSheet
finished = False
For count = 1 To 50
Next count
count = 1
Dim TaskString As String
Do While finished = False
TaskString = TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.ElementOfWork)).Text
If TaskString = vbNullString Then
finished = True
ElseIf TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Tier)).Value = 2 Then
ElementListBox.AddItem (TaskString)
ElementListBox.Selected(count - 1) = TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Included)).Value
Debug.Print (TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Included)).Value)
End If
count = count + 1
Loop
End Function

Do you need to convert that value to a boolean?
ElementListBox.Selected(count - 1) = CBool(TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Included)).Value)
Let's start eliminating some potential causes!
Does this work?
ElementListBox.Selected(count - 1) = true
Try this (replace your code from count=1 to Loop)...
count = 1
Dim itemCount as Integer
itemCount = 1
Dim TaskString As String
Do While finished = False
TaskString = TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.ElementOfWork)).Text
If TaskString = vbNullString Then
finished = True
ElseIf TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Tier)).Value = 2 Then
ElementListBox.AddItem (TaskString)
ElementListBox.Selected(itemCount - 1) = CBool(TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Included)).Value)
Debug.Print (TaskListSheet.Cells(TaskListCellRef(Task, ref.Row) + count + 1, TaskBreakdownColumnRefs(TaskBreakdownColumnHeaders.Included)).Value)
itemCount = itemCount +1
End If
count = count + 1
Loop
Note the addition of the itemCount variable to count the number of items in the listbox

Related

How do I evaluate conditions passed into a function?

I'm attempting to code a CONCATENATEIFS function in VBA that works like SUMIFS, etc. Here's an example call:
=ConcatenateIfs(",",$E$6:$E$9,$F$6:$F$9,"Something",$G$6:$G$9,">=2")
Public Function ConcatenateIfs(JoinStr As String, StrRange As Range, ParamArray var() As Variant) As String
Dim numberOfConditions As Integer
numberOfConditions = (UBound(var) - LBound(var) + 1) / 2
Dim tmpResult As String
tmpResult = ""
Dim includeItem As Boolean
For Item = 1 To StrRange.Count
includeItem = True
For Condition = 1 To numberOfConditions:
If var((Condition - 1) * 2)(Item) <> var((Condition - 1) * 2 + 1) Then
includeItem = False
End If
Next Condition
If includeItem = True And Item = 1 Then
tmpResult = StrRange(Item)
ElseIf includeItem = True Then
tmpResult = tmpResult + JoinStr + StrRange(Item)
End If
Next Item
ConcatenateIfs = tmpResult
End Function
The above function never seems to recognize that a condition has been met, meaning this part of the code is not working (i.e. that it always evaluates the inequality to True):
If var((Condition - 1) * 2)(Item) <> var((Condition - 1) * 2 + 1) Then
includeItem = False
End If
How do I fix this so that the conditions are tested properly between an item of the criteria_range and the criteria itself? Bonus points: how do I break out of the condition loop as soon as a criteria (properly) is not met?

Value of type 'Single' can't be converted to 'System.Windows.Forms.DataGridViewCell'

For i = 0 To 2
If Niz1(i) > Niz2(i) Then
a = Niz1(i)
b = Niz2(i)
Call ZamjenaNiza(a, b)
Niz1(i) = Prvi
Niz2(i) = Drugi
End If
Next i
For j = 0 To 3
Me.DataGridView(j + 1, 1) = Niz1(j)
Me.DataGridView(j + 1, 2) = Niz2(j)
Next j
End Sub
Can anyone please help me with this problem? Can't find solution, not even on Visual Basic help page! It shows me error on this 2 code lines:
Me.DataGridView(j + 1, 1) = Niz1(j)
Me.DataGridView(j + 1, 2) = Niz2(j)
It says : Value of type 'Single' cannot be converted to 'System.Windows.Forms.DataGridViewCell'
Instead of trying to assign a Single value to a DataGridViewCell object, you should assign it to the .Value property of the object ..
Me.DataGridView(j + 1, 1).Value = Niz1(j)

vba array element removal

j = LBound(arrayTime)
Do Until j = UBound(arrayTime)
j = j + 1
b = b + 1
cnc = b + r
MsgBox cnc
If cnc > 7 Then
b = 0
r = 0
cnc = b + r
End If
numMins = Sheet5.Cells(cnc + 3, 2) - arrayTime(j)
If numMins < 0 Then
g = g + 1
ReArrangeArray arrayTime, j
'ReDim Preserve arrayTime(numrows - 1 + g)
'arrayTime(numrows - 1 + g) = arrayTime(j)
'MsgBox (arrayTime(numrows - 1 + g))
Else
Sheet5.Cells(cnc + 3, 2) = numMins
End If
Loop
If the if statement is true I want to be able to put the array value at the end of the array and remove that value from its current spot. As the code is, it just adds it to the end and increases the size of the array from 12 to 13. How can I get the array to remain size 12 and still place the value at the end of the array and then remove it from its original position? I do not want to touch the array values in front. Just want to take that value and move it to the end.
For instance
array(1,2,3,4,5)
If statement
j on third loop.
array(j)=3
end array should be
array(1,2,4,5,3)
You could use a helper Sub like this one:
Sub ReArrangeArray(inputArray as Variant, indexToSwap as long)
Dim I As Long
Dim tempVal As Variant
If indexToSwap >= LBound(inputArray) And indexToSwap < UBound(inputArray) Then
tempVal = inputArray(indexToSwap)
For I = indexToSwap To UBound(inputArray) - 1
inputArray(i) = inputArray(i + 1)
Next I
InputArray(UBound(inputArray)) = tempVal
End If
End Sub
To be called by your main Sub as follows:
ReArrangeArray arrayTime, j

Moving textbox output into a different textbox

I am trying to output text into another text box once the first has 5 entries in it. Example; i give the scores 100,200,300,200,200. Now when I try to enter a new score it should place it in the next textbox, but doesent.
Dim Testint As Integer ' define an Integer for testing
Dim sampleTextBox(3) As TextBox
sampleTextBox(0) = txtPlayer1Scores
sampleTextBox(1) = txtPlayer2Scores
sampleTextBox(2) = txtPlayer3Scores
sampleTextBox(3) = txtPlayer4Scores
Dim sampleLabel(3) As Label
sampleLabel(0) = lblPlayer1Average
sampleLabel(1) = lblPlayer2Average
sampleLabel(2) = lblPlayer3Average
sampleLabel(3) = lblPlayer4Average
scoreArray(textCount, gameNumber - 1) = CInt(txtScoreInput.Text) ' subtracting 1 from the score array
sampleTextBox(textCount).Text &= " Score:" & scoreArray(textCount, gameNumber - 1) & vbCrLf
'output statement
gameNumber = gameNumber + 1 'increment the counter
If gameNumber > MAX_SCORE_LENGTH Then
sampleTextBox(textCount).Focus()
sampleTextBox(textCount).Enabled = False
For i As Integer = 0 To 4 'Add the array values up
scoreTotal += scoreArray(textCount, i)
Next
playerAverage = scoreTotal / MAX_SCORE_LENGTH
sampleLabel(labelCount).Text = playerAverage
' I need the textbox switch here
textCount = textCount + 1
labelCount = labelCount + 1 ' and labels
ElseIf textCount > MAX_PLAYERS Then
'calculate team average
btnEnterScore.Enabled = False
Else
lblEnterScore.Text = "Enter Score for game #" & gameNumber ' 5 scores have not be inputted,
txtScoreInput.Text = "" 'ask for more
txtScoreInput.Focus() 'refocus the input textbox
End If
Fixed it...setting the max length to 15 forces it to move on after 15 digits, it also works when there are less than 15 digits
txtscore1.MaxLength = 15

Working with Excel ranges and arrays

In VBA, I can easily pull in an sheet\range into an array, manipulate, then pass back to the sheet\range. I'm having trouble doing this in VB.Net though.
Here's my code.
Rng = .Range("a4", .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
Dim SheetArray(,) As Object = DirectCast(Rng.Value(Excel.XlRangeValueDataType.xlRangeValueDefault), Object(,))
For X As Integer = 0 To SheetArray.GetUpperBound(0)
If IsNothing(SheetArray(X, 0)) Then Exit For
SheetArray(X, 6) = SheetArray(X, 3)
SheetArray(X, 7) = CDbl(SheetArray(X, 3).ToString) - CDbl(SheetArray(X, 1).ToString) - _
CDbl(SheetArray(X, 7).ToString)
For Y As Integer = 0 To 3
SheetArray(X, Y * 2 + 1) = Math.Round(CDbl(SheetArray(X, Y * 2 + 1).ToString), 3)
Next
If Math.Abs(CDbl(SheetArray(X, 7).ToString)) > 0.1 Then _
.Range(.Cells(X + 1, 1), .Cells(X + 1, 8)).Font.Color = -16776961
Next
I'm getting an error on the first If IsNothing(SheetArray(X, 0)) Then Exit For
line. It is telling me index is out of bounds of the array. Any idea why? The SheetArray object contains the data, but I just am not sure how to get to it.
In the For you have to loop from 0 to Count - 1:
For X As Integer = 0 To SheetArray.GetUpperBound(0) - 1
'...
Next
That will fix your problem.