Add the first item to my listbox if empty vba - excel

Hi I have a userform with a 'search' listbox and a 'results' listbox. If I first import data into the results listbox ' lstresults ' from another array my code works and I can import individual items from ' lstsearch ' and it shows a new item in 'lstresults'.
When the lstresults is empty though before attempting to add data I can see the data has been added in my watch to a list variable in results but it is not visible in the lstresults. I have fiddled with various elements of the code but I must be missing something. Any help appreciated:
Private Sub cmdAddPlant_Click()
' Need to take data from selected line item from search box
' Add item to results list
lstResults.Visible = True
Dim ctlsource As Control
Dim plnt As Integer
Set ctlsource = Me!lstSearch
For plnt = 0 To ctlsource.ListCount - 2
If ctlsource.Selected(plnt) = True Then
With Me.lstResults.List
If lstResults.ListCount > 0 Then _
Me.lstResults.AddItem
Me.lstResults.List(lstResults.ListCount - 1, 0) = lstSearch.List(plnt, 0)
Me.lstResults.List(lstResults.ListCount - 1, 1) = lstSearch.List(plnt, 1)
Me.lstResults.List(lstResults.ListCount - 1, 3) = lstSearch.List(plnt, 2)
Me.lstResults.List(lstResults.ListCount - 1, 2) = lstSearch.List(plnt, 3)
Else
' I added this to try and deal with the first item but no dice
lstResults.AddItem
lstResults.List(0, 0) = lstSearch.List(plnt, 0)
lstResults.List(0, 1) = lstSearch.List(plnt, 1)
lstResults.List(0, 3) = lstSearch.List(plnt, 2)
lstResults.List(0, 2) = lstSearch.List(plnt, 3)
End If
End With
lstSearch.RemoveItem (plnt) ' Avoids accidently selecting plant twice
End If
Next plnt
With lstResults
Dim sTemp As String
Dim sTemp2 As String
Dim LbList As Variant
'Store the list in an array for sorting
LbList = Me.lstResults.List
If UBound(LbList) > 1 Then
'Bubble sort the array on the first value
For i = LBound(LbList, 1) To UBound(LbList, 1) - 1
For j = i + 1 To UBound(LbList, 1)
If LbList(i, 0) > LbList(j, 0) Then
'Swap the first value
sTemp = LbList(i, 0)
LbList(i, 0) = LbList(j, 0)
LbList(j, 0) = sTemp
'Swap the other values
sTemp2 = LbList(i, 1)
LbList(i, 1) = LbList(j, 1)
LbList(j, 1) = sTemp2
sTemp3 = LbList(i, 2)
LbList(i, 2) = LbList(j, 2)
LbList(j, 2) = sTemp3
sTemp4 = LbList(i, 3)
LbList(i, 3) = LbList(j, 3)
LbList(j, 3) = sTemp4
End If
Next j
Next i
'Remove the contents of the listbox
lstResults.Clear
'Repopulate with the sorted list
lstResults.List = LbList
End If
End With
Set LbList = Nothing
End Sub
Thanks - pic of screen to help you visualize....
Userform

This should work regardless of whether or not the list is empty
Dim i As Long
With lstResults
.AddItem lstSearch.List(plnt, 0)
i = .ListCount - 1
.List(i, 1) = lstSearch.List(plnt, 1)
.List(i, 2) = lstSearch.List(plnt, 2)
.List(i, 3) = lstSearch.List(plnt, 3)
End With

Related

Excel-VBA update userform listbox based on existing list

I have a useform with multicolumn listbox which lists items and its quantity. The intent is to be able to dynamically update the quantity by adding or deducting from a textbox input. Below is my current code roughly to realize this. So far it is not working with invalid qualifier error for selected(i). would appreciate any guidance on this
Private Sub CB_AddOrder_Click()
Dim j, k, qty As Integer
Dim i As Variant
qty = TB_Qty.Value
If qty = 0 Then
Exit Sub
End If
j = LB_Order.ListCount - 1
Debug.Print j
If j < 0 Then
j = 0
End If
'Iterate to check if selected menu already existed in ordered list
For i = 0 To LB_Menu.ListCount - 1
If LB_Menu.Selected(i) = True Then
Debug.Print Selected(i)
For k = 0 To j
If LB_Menu.Selected(i).List(i, 0) = LB_Order.List(k, 0) Then
LB_Order.List(k, 3) = LB_Order.List(k, 3).Value + qty
Exit Sub
End If
Next k
With LB_Order
.ColumnCount = 5
.ColumnWidths = "120;60;60;60;60"
.AddItem
.List(j, 0) = LB_Menu.List(i, 0)
.List(j, 1) = LB_Menu.List(i, 1)
.List(j, 2) = LB_Menu.List(i, 2)
.List(j, 3) = qty
.List(j, 4) = Format(qty * LB_Menu.List(i, 2), "0.00")
End With
End If
Next i
End sub
The confusion you're having relates from the difference in which listbox item(s) are selected and the value of those selected item(s). So when you check for Selected:
Dim i As Long
For i = 0 To LB_Menu.ListCount - 1
If LB_Menu.Selected(i) Then
Debug.Print "Menu selected (" & i & ") = " & LB_Menu.List(i, 0)
End If
Next i
Once you determine which index (i in this case) is selected, you refer to the value by using the index into the List.
The Object Required error you received is because your statement
LB_Order.List(k, 3) = LB_Order.List(k, 3).Value + qty
is using .Value for the list item. This item is a value, not an object.
Here is your sub rewritten as an example. Notice that I'm using single-character variables as loop indexes (which is good), but not as a meaningful value. I renamed other variables in (a hopefully) meaningful way to make your code a little more self-documenting.
Option Explicit
Private Sub CB_AddOrder_Click()
Dim additionalQty As Long
additionalQty = TB_Qty.Value
If additionalQty = 0 Then
Exit Sub
End If
Dim countOfOrderItems As Long
countOfOrderItems = LB_Order.ListCount - 1
If countOfOrderItems < 0 Then
countOfOrderItems = 0
End If
'Iterate to check if selected menu already existed in ordered list
Dim i As Long
For i = 0 To LB_Menu.ListCount - 1
If LB_Menu.Selected(i) Then
Debug.Print "Menu selected (" & i & ") = " & LB_Menu.List(i, 0)
'--- find the matching item and increase the quantity
Dim k As Long
For k = 0 To countOfOrderItems
If LB_Menu.List(i) = LB_Order.List(k, 0) Then
LB_Order.List(k, 3) = LB_Order.List(k, 3) + additionalQty
Exit Sub
End If
Next k
'--- append the new item from the Menu to the Order
With LB_Order
.ColumnCount = 5
.ColumnWidths = "120;60;60;60;60"
.AddItem
.List(countOfOrderItems, 0) = LB_Menu.List(i, 0)
.List(countOfOrderItems, 1) = LB_Menu.List(i, 1)
.List(countOfOrderItems, 2) = LB_Menu.List(i, 2)
.List(countOfOrderItems, 3) = additionalQty
.List(countOfOrderItems, 4) = Format(additionalQty * LB_Menu.List(i, 2), "0.00")
End With
End If
Next i
End Sub
By the way, make sure all of the columns in your listboxes are initialized with values if you will add/subtract number values. If they are just Null, you'll get a Could not set the List property error.

Sorting dates using vba

I have a list of data displayed on a listbox, after clicking on a button the list appears on my userform.
I have dates on column 2 of my list, I want to do a descending sorting.
I have the code bellow but it's not working, am I wrong ?
fin_col_Form_Init = Ws.Cells(6, 256).End(xlToLeft).Column
UF_Profil_Edit1.ListBox_Form_Init.ColumnCount = 2
UF_Profil_Edit1.ListBox_Form_Init.ColumnWidths = "300;100"
fin_col_Form_Init = Ws.Cells(6, 256).End(xlToLeft).Column
UF_Profil_Edit1.ListBox_Form_Init.ColumnCount = 2
UF_Profil_Edit1.ListBox_Form_Init.ColumnWidths = "300;100"
For i = 2 To fin_col_Form_Init
UF_Profil_Edit1.ListBox_Form_Init.AddItem Ws.Cells(6, i)
UF_Profil_Edit1.ListBox_Form_Init.List(UF_Profil_Edit1.ListBox_Form_Init.ListCount - 1, 1) = Ws.Cells(7, i)
Next i
Dim y, x As Integer
Dim MyList As Variant
With UF_Profil_Edit1.ListBox_Form_Init
For y = 0 To .ListCount - 1
For x = y To .ListCount - 1
If CDate(.List(x, 1)) > CDate(.List(y, 1)) Then
For c = 0 To 2
MyList = .List(x, c)
.List(x, c) = .List(y, c)
.List(y, c) = MyList
Next c
End If
Next x
.List(y, 2) = Format(.List(y, 2), "####.00")
Next y
End With
Try the next code, please:
Sub testSortListBox()
Dim i As Long, j As Long, sTemp As Date, sTemp2 As String, SortList As Variant
UF_Profil_Edit1.ListBox_Form_Init.ColumnCount = 2
UF_Profil_Edit1.ListBox_Form_Init.ColumnWidths = "300;100"
'Store the list in an array to be sorted:
SortList = UF_Profil_Edit1.ListBox_Form_Init.List
'Sort the array on the second column
For i = LBound(SortList, 1) To UBound(SortList, 1) - 1
For j = i + 1 To UBound(SortList, 1)
If CDate(SortList(i, 1)) < CDate(SortList(j, 1)) Then
'Swap the second value
sTemp = SortList(i, 1)
SortList(i, 1) = SortList(j, 1)
SortList(j, 1) = sTemp
'Swap the first value
sTemp2 = SortList(i, 0)
SortList(i, 0) = SortList(j, 0)
SortList(j, 0) = sTemp2
End If
Next j
Next i
'Remove the contents of the listbox:
UF_Profil_Edit1.ListBox_Form_Init.Clear
'Load the sorted array in the list box:
UF_Profil_Edit1.ListBox_Form_Init.List = SortList
End Sub
But, please note: The list box in discussion must not be linked to a range (not being load by its RowSource property...

How do I append an initially empty string array in VBA?

I am trying to add a variable number of items to a string array.
My code is in a worksheet change function:
Dim StartNums(0 To 2) As String
doneColor = RGB(175, 175, 175)
cmt = FRg.Comment.Text
rowLen = InStr(1, cmt, vbLf)
If rowLen = 0 Then
rowLen = Len(cmt)
End If
numChunks = rowLen / 32
numRows = Len(cmt) / rowLen
' For i = 1 To 12 'FRg.Comment.Shape.TextFrame.Characters.Count
' With FRg.Comment.Shape.TextFrame.Characters(i, 1)
' If .Font.Strikethrough = True Then
' .Font.Color = vbGreen
' End If
' End With
' Next i
MsgBox ("About to fill StartNums, nothing should be in it yet")
For j = 0 To numChunks - 1
MsgBox ("going to add stuff for chunk " & j)
If Not UBound(StartNums) = 2 Then
' MsgBox ("resizing an empty array")
' ReDim Preserve StartNums(3) As Variant
' Else
'MsgBox ("resizing a non-empty array")
ReDim Preserve StartNums(UBound(StartNums) + 3) As String
End If
StartNums(UBound(StartNums) - 2) = (j * 32) + 5 + (0 * 9)
StartNums(UBound(StartNums) - 1) = (j * 32) + 5 + (1 * 9)
StartNums(UBound(StartNums) - 0) = (j * 32) + 5 + (2 * 9)
Next j
Now whenever I go into the worksheet, the ReDim line has a Compile Error Array already dimensioned. I'm aware it's already dimensioned, which is why I'm ReDim-ing it.
How do I add 3 more spaces in an array?
When you initially Dim it, you can't give it the size if you plan on changing the size later:
so instead of
Dim StartNums(0 To 2) As String
You would use
Dim StartNums() As String
and then on the next line
ReDim StartNums(0 To 2)
note, you can also use this, as it's assumed to be 0 based by default.
ReDim StartNums(2)
That will accomplish the same thing, but then you can later use Redim Preserve to change the size of it.

Excel keeps freezing on running Macro

So I am using the following code to make a bunch of decisions based on values in table columns. I have taken each table column containing values that go into making the decision in variant arrays. And then used a combination of for and while loops to assign decisions in the ans() variant array.
The problem is, every time I run the macro my Excel hangs.
I tried the usual method of adding automatic calculations and disabling events and screen updates. But it did not help the matter in any way. I tried simplifying my code as well but this is about as much simplification I can include while still achieving what I would like the code to. Can someone please tell me what else I can do to make this run?
Dim sh As Worksheet
Set sh = Sheets("LOGIC")
Dim t As ListObject
Set t = sh.ListObjects("Table8")
n = t.ListRows.Count
Dim rel() As Variant
rel = t.ListColumns(61).DataBodyRange.Value
Dim dc() As Variant
dc = t.ListColumns(62).DataBodyRange.Value
Dim t_req() As Variant
t_req = t.ListColumns(63).DataBodyRange.Value
Dim sc_req() As Variant
sc_req = t.ListColumns(64).DataBodyRange.Value
Dim x_req() As Variant
x_req = t.ListColumns(65).DataBodyRange.Value
Dim bo() As Variant
bo = t.ListColumns(69).DataBodyRange.Value
Dim ans() As Variant
ans = t.ListColumns(70).DataBodyRange.Value
Dim reqkind() As Variant
reqkind = t.ListColumns(2).DataBodyRange.Value
For i = 2 To n Step 1
If rel(i, 1) = 0 Or ans(i, 1) <> 0 Then
GoTo Nexti
ElseIf ans(i, 1) = 0 And rel(i, 1) = 1 Then
While t_req(i, 1) > 0
For j = i To n - 1
If dc(i, 1) > 0 Then
If reqkind(i, 1) = "" Then
ans(i, 1) = "YES"
t_req(i, 1) = t_req(i, 1) - 1
sc_req(i, 1) = sc_req(i, 1) - 1
ElseIf sc_req(i, 1) <= 0 Then
ans(i, 1) = "YES"
t_req(i, 1) = t_req(i, 1) - 1
x_req(i, 1) = x_req(i, 1) - 1
Else: GoTo Nextj
End If
ElseIf reqkind(i, 1) = "" Then
If bo(i, 1) > 0 Then
ans(i, 1) = "YES"
t_req(i, 1) = t_req(i, 1) - 1
bo(i, 1) = bo(i, 1) - 1
Else
ans(i, 1) = "NO"
t_req(i, 1) = t_req(i, 1) - 1
End If
Else
ans(i, 1) = "NO"
t_req(i, 1) = t_req(i, 1) - 1
End If
Nextj:
Next j
Wend
End If
Nexti:
Next i```

Listbox sorting using bubble method skipping first item in listbox

I need help customizing this bubble sort code so that it will skip the first item in the listbox and only sort a-z on the rest of the items in the listbox. I'm lost and need some directions. Thanks
Dim j As Long
Dim sTemp As String
Dim sTemp2 As String
Dim LbList As Variant
'Store the list in an array for sorting
LbList = Me.WorksheetListBox.List
'Bubble sort the array on the first value
For i = LBound(LbList, 1) To UBound(LbList, 1) - 1
For j = i + 1 To UBound(LbList, 1)
If LbList(i, 0) > LbList(j, 0) Then
'Swap the first value
sTemp = LbList(i, 0)
LbList(i, 0) = LbList(j, 0)
LbList(j, 0) = sTemp
'Swap the second value
sTemp2 = LbList(i, 1)
LbList(i, 1) = LbList(j, 1)
LbList(j, 1) = sTemp2
End If
Next j
Next i
'Remove the contents of the listbox
Me.WorksheetListBox.Clear
'Repopulate with the sorted list
Me.WorksheetListBox.List = LbList

Resources