I need to select a list box on a form in Excel which contains both numbers and words. I need to use the userform code to Count many numbers are in the selected ListBox. I am using this code:
Private Sub RUNButton_Click()
S = 0
For i = 0 To ListBox1.ListCount - 1
If IsNumeric(ListBox1.List(i)) = True Then
S = S + ListBox1.List(i)
End If
Next
MsgBox ("Number quantity " & S)
End Sub
But this code sums the numbers, I want to count.
Like if there are 1, 3, 5, and 6 in the ListBox then msgBox would say 4
How I can get this?
Related
I have 2 qns that should be performed in VBA Code.
1. I want to count the total number of times a particular string has repeated for more than 40 unique values in a column.how this can be achieved.
for eg- unique values like Apple, banana, grapes (40 more unique values) are repeated in a column and I want the count of individual string like this.
Apple- 30 times repeated
banana- 4 times repeated.
after taking the total number of each strings,I want to count them with a specific criteria.
Eg- count apple, only if the cost if above 40
count grapes, only if the cost if above 40
can any1 pls help on this, how to implement this in VBA Code.
The following code adds all strings from Column A into a collection structure, sorts it while counting each unique value and stores each unique value and the corresponding sum in a dictionary structure. The results are then printed to the Immediate window. Hope this helps.
Sub main()
'variables
Dim colCollection As New Collection
Dim x, q As Variant
Dim cellValue As String
Dim j, i, count As Integer
Dim numbers As New Scripting.Dictionary 'NOTE: add microsoft scripting Runtime Ref
x = 1 'collections start at 1
While Worksheets("Sheet1").Cells(x, "A").Value <> "" 'while cell is not empty
cellValue = Worksheets("Sheet1").Cells(x, "A").Value 'store string value from cell
colCollection.Add (cellValue) ' add entry from cell to collection
x = x + 1 'increment
Wend
'Sort collection (bubbble sort) and record number of each unique item
For i = colCollection.count To 2 Step -1 'count down from collection
For j = 1 To i - 1
'bubble up item
If colCollection(j) > colCollection(j + 1) Then
colCollection.Add colCollection(j), After:=j + 1
colCollection.Remove j
End If
Next j
'finding count of unique item
If i <> colCollection.count Then 'if not at last item (can't compare 2 items when only given 1)
If i = 2 Then 'if at end
numbers.Add colCollection(i), count + 3 'add sum to dictionary with corresponding key value
Else
If StrComp(colCollection(i + 1), colCollection(i), 1) = 0 Then 'if same string
count = count + 1 'increment count
Else
numbers.Add colCollection(i + 1), count + 1 'add sum to dictionary with corresponding key value
count = 0 'reset count
End If
End If
End If
Next i
'loop through dictionary
For Each q In numbers.Keys
Debug.Print q & "- " & numbers.Item(q); " times repeated."
Next
End Sub
i have two Listboxes in Access VBA.
I want to compare These two listboxes and want to delete Items from the second listbox, if the same Item isn't listed at the first listbox.
For example:
Listbox 1 Values: "Item 1", "Item 3"
Listbox 2 Values: "Item 1", "Item 2", Item 3"
Now i want a function that compares These two Listboxes and deletes "Item 2" from the Listbox 2, because it isn't listed in the Listbox 1.
I tried some code, but the only Thing i've got is this one:
If BR_TeamReport.ListCount > 0 Then
For i = 0 To BR_TeamReport.ListCount - 1
For y = 0 To BR_Team.ListCount - 1
If BR_TeamReport.ItemData(i) = BR_Team.ItemData(y) Then
MsgBox ("Don't Delete")
Else
MsgBox ("Delete")
End If
Next y
Next i
End If
Consider this:
If BR_TeamReport.ListCount > 0 Then
For i = 0 To BR_TeamReport.ListCount - 1
FoundItem = False
For y = 0 To BR_Team.ListCount - 1
If BR_TeamReport.ItemData(i) = BR_Team.ItemData(y) Then
FoundItem = True
End If
Next y
If Not FoundItem Then
' Delete item as it was not found in the first listbox
BR_Team.RemoveItem (y)
End If
Next i
End If
I think this will achieve what you want.
Why not clear 2nd list box, and then repopulate with first one?
For i = 0 To LstBox2.ListCount - 1
LstBox2.RemoveItem(i)
next i
For i = 0 TO LstBox1.ListCount - 1
lstBox2.AddItem LstBox1.ItemData(i)
Next i
I have one "release" button which: assigns numbers to specific cells, counts numbers, creates PDF documents, makes history stamps and so on.
I need to automatically generate buttons based on number value with different macros.
For example:
If target cell value = 4, then create 4 buttons with assigned macro 1, 2, 3, 4.
If value = 5, then create 5 buttons and assign macro 1, 2, 3, 4, 5 and so on.
Every assigned macro will be different. (Max count of buttons should be 20.)
Within your sheet, you should create the 20 buttons. From here assign them to their macro of equal value, and hide each one. From here you can loop to enable visibility for your current target cell value. In this case A1.
Dim MyVal As Long
MyVal = Range("A1").Value
For i = 1 To MyVal
ActiveSheet.Buttons("Button " + CStr(i)).Visible = True
Next i
You'll have to sort the deleting etc, but something like this
Sub SortButtons()
Dim intButton As Integer
Dim cbNewButton As Button
Const intHeight = 30
For intButton = 1 To 4
Set cbNewButton = ActiveSheet.Buttons.Add(224.25, (intButton * intHeight) + 20, 90.75, intHeight)
cbNewButton.OnAction = "Macro" & intButton
cbNewButton.Text = "Button for Macro " & intButton
cbNewButton.Name = "OK_TO_DELETE_" & intButton
Next intButton
End Sub
I have a ListView with multiple columns. More precisely, the ListView contains 8 columns. 2 of them should be filled with checkboxes.
Currently only the first column contains checkboxes. It is defined as follows:
While Not rs.EOF
//first column with checkboxes
ListViewCustomer.ListItems.Add , , rs("Id")
ListViewCustomer.ListItems(ListViewCustomer.ListItems.Count).tag = rs("Status")
//second column etc.
ListViewCustomer.ListItems(ListViewCustomer.ListItems.Count).ListSubItems.Add , , rs("name")
....
//Here is the second column, which doesn't display the checkboxes
ListViewCustomer.ListItems(ListViewCustomer.ListItems.Count).ListSubItems.Add , , IIf(IsNull(rs("date_from")), "", rs("date_from"))
ListViewCustomer.ListItems(ListViewCustomer.ListItems.Count).tag = rs("Status2")
Wend
Do anyone have an idea how to add the checkboxes in the last column?
EDIT:
Is it possible to realize this column with adding via .Controls?
A ListView is a more expanded version of the ListBox control.
See ListBox control on msdn as well.
They both display records of rows (the ListView has more advanced formatting options). This however means that a record is a row. Therefore you select a row when you select one of the items.
The function of the checkbox is to allow the user to mark the row(s) that is the records(s) he selects.
Thus there is only one checkbox per row, at the front of the row.
Consider this code (this is Excel 2003 VBA, but gives you the idea):
Private Sub UserForm_Initialize()
Dim MyArray(6, 8)
'Array containing column values for ListBox.
ListBox1.ColumnCount = 8
ListBox1.MultiSelect = fmMultiSelectExtended
'Load integer values MyArray
For i = 0 To 5
MyArray(i, 0) = i
For j = 1 To 7
MyArray(i, j) = Rnd
Next j
Next i
'Load ListBox1
ListBox1.List() = MyArray
End Sub
You could do a custom ListBox or ListView if you really want. You could create a frame and put Labels and CheckBoxes on it. This is the only way to do this in Excel2003 where I tested. The ListBox object has no Controls child.
But this is more like a datagrid and not really a ListBox or ListView which by definition are a listing of records (rows).
Update:
I saw your update and that you really want to place the CheckBox at the end of the row.
If you only want one checkbox at the last row, you could do this custom checkbox. Again this is written for the ListBox, so need to convert it to your ListView if you want to.
Still requires a custom handling, but I had some time, so I did this code. See if you like it:
Private Sub ListBox1_Change()
For i = 0 To ListBox1.ListCount - 1
ListBox1.List(i, 3) = ChrW(&H2610)
Next i
ListBox1.List(ListBox1.ListIndex, 3) = ChrW(&H2611)
End Sub
Private Sub UserForm_Initialize()
Dim MyArray(5, 3)
'Array containing column values for ListBox.
ListBox1.ColumnCount = 4
ListBox1.MultiSelect = 0
ListBox1.ListStyle = 0
'Load integer values MyArray
For i = 0 To 5
MyArray(i, 0) = i
For j = 1 To 2
MyArray(i, j) = Rnd
Next j
MyArray(i, 3) = ChrW(&H2610)
Next i
'Load ListBox1
ListBox1.List() = MyArray
End Sub
I am new at VBA.So kindly help me on this matter.
My UserForm has two ListBox controls in it, each with two columns. For example, ListBox1
Name Item
A 20
B 30
and listbox2:
Name Item
A 20
B 40
When I click a CommandButton, the procedure below attempts to compare both ListBox controls and returns whether or not the data in each column of data is correct. I believe the best approach would be to first compare Column 1 of ListBox1 with Column 1 of ListBox2. If those are identical, then compare the second columns of both ListBox controls. The procedure is supposed to return a MsgBox that says "Correct" if all columns are identical. Otherwise, the program should return a mismatch error. Here is the code I've tried so far.
Private Sub CommandButton1_Click()
Dim p As Integer, Tabl()
Redim Tabl(0)
For i = 0 To ListBox1.ListCount - 1
p = p + 1
Redim Preserve Tabl(p)
Tabl(p) = ListBox1.List(i)
Next i
For i = 0 To ListBox2.ListCount - 1
If IsNumeric(Application.Match(ListBox2.List(i), Tabl, 0)) Then
Msgbox"Correct"
End If
Next i
End Sub
Unfortunately, the program only calculates the first column repeatedly. How can I compare multiple columns?
Based on your description and a small evaluation of what your code does, you may be overthinking this. How about the following?
Private Sub CommandButton1_Click()
Dim myMsg As String
Dim byeMsg As String
myMsg = "Same name chosen."
byeMsg = "Those names don't match."
If ListBox1.Value = ListBox2.Value Then
MsgBox myMsg
Else
MsgBox byeMsg
End If
End Sub
Of course, instead of displaying a message using MsgBox, you could just as easily replace it with any code you need.