How to output info to a listbox? - vba

This code gives me
"data member not found"
when trying to output my info to a listbox.
Dim ClassYoga(5) As Integer
Dim NumOfAttend As Integer
Dim index As Integer
'initialize array
index = 0
Do Until index > 4
ClassYoga(index) = 0
index = index + 1
Loop
'first input from user
NumOfAttend = InputBox("How many people will be attending class? (555 to quit")
Do Until NumOfAttend = 555
ClassYoga(NumOfAttend - 1) = ClassYoga(NumOfAttend - 1) + 1
NumOfAttend = InputBox("How many people will be attending class? (555 to quit")
Loop
'display
index = 0
lstYoga.RowSource = vbNullString
Do Until index > 4
lstYoga.AddItem ((index + 1) & "Attendants :" * ClassYoga(index))
Loop
It returns errors on the .rowsource and .additem functions.
How can I output my results?

In the last do-loop you do not increment index,

Related

Transferring Data Between Tables with Word VBA?

I have document containing all the questions in a certain test along with a table of its statistics. I'm attempting to transfer data between these tables, specifically inserting the percentage of people who chose a certain multiple choice answer into a box beside the actual answer in the question.
I've attached a screenshot of what the question table and statistic table look like 1, there are 25 question tables in my document and one statistics table that goes on for 25 question.
Below is my code. The portion under the Else condition is functional but I can't seem to get my first If Condition and loop to collect the data from the statistics table into the array I set up. Hopefully someone can provide insight into why the first section is not working.
Sub Insert_Statistics()
Dim QTable As Table
Dim RowCount As Integer
Dim StringValue As String
Dim i As Integer
Dim j As Integer
Dim A(35) As String
Dim B(35) As String
Dim C(35) As String
Dim D(35) As String
For Each QTable In ActiveDocument.Tables
If RowCount > 14 Then
Do While i < 25
A(i + 1) = QTable.Rows(4 * i + 4).Cells(4).Range.Text
B(i + 1) = QTable.Rows(4 * i + 4).Cells(5).Range.Text
C(i + 1) = QTable.Rows(4 * i + 4).Cells(6).Range.Text
D(i + 1) = QTable.Rows(4 * i + 4).Cells(7).Range.Text
i = i + 1
Loop
Else
QTable.Rows(1).Cells(2).Select
StringValue = Selection.Text
j = Val(StringValue)
QTable.Rows(6).Cells(3).Range.Text = A(j)
QTable.Rows(6).Cells(3).Range.ParagraphFormat.Alignment =
Word.WdParagraphAlignment.wdAlignParagraphLeft
QTable.Rows(7).Cells(3).Range.Text = B(j)
QTable.Rows(7).Cells(3).Range.ParagraphFormat.Alignment =
Word.WdParagraphAlignment.wdAlignParagraphLeft
QTable.Rows(8).Cells(3).Range.Text = C(j)
QTable.Rows(8).Cells(3).Range.ParagraphFormat.Alignment =
Word.WdParagraphAlignment.wdAlignParagraphLeft
QTable.Rows(9).Cells(3).Range.Text = D(j)
QTable.Rows(9).Cells(3).Range.ParagraphFormat.Alignment =
Word.WdParagraphAlignment.wdAlignParagraphLeft
QTable.AutoFitBehavior wdAutoFitWindow
End If
Next
End Sub

count repeated values in column for unique fileds

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

VBA Match value from listbox object to range

I am trying to check items in a listbox according to a range of cells (that matches)
This is what I've done so far.
Dim j As Integer
Dim lItem As Long
Dim rowx as Long
rowx = 12
j = 0
For lItem = 0 To Worksheets("Bordereau Prep").ListBoxPlot.ListCount
If Worksheets("Bordereau Prep").ListBoxPlot.List(lItem) = Worksheets("Liste").Cells(rowx, 40 + j) Then
Worksheets("Bordereau Prep").ListBoxPlot.Selected(lItem) = True
j = j + 1
End If
Next lItem
This does what I want, checking the items in the list that are in range_pr_el but it throws an error at :
If Worksheets("Bordereau Prep").ListBoxPlot.List(lItem) = Worksheets("Liste").Cells(rowx, 40 + j) Then
Telling me "Error 381 : Impossible to read List property. Index of the property table not valid". And I don't understand why, because it does enter the loop, and it does do what it's supposed to. What is missing to correct the error?
Thank you in advance
Try using
For lItem = 0 To Worksheets("Bordereau Prep").ListBoxPlot.ListCount - 1
When going through the for loop the last iteration will have lItem equal the number of list items. However, the list index starts at 0 so there should be a difference of 1.
For example if you had 1 list item the .ListCount method would give you 1 so the for loop will try to access list item with index 0 and list item with index 1. This would give you an error because the list box doesn't have 2 items.
`

Search a column and delete another row if phrase found VBA

I have Column A and what I'm looking to do is search for a phrase, say "test" and then if this phrase is found delete 2 rows after that.
I can see how to delete a row if the phrase is found in that row but not how to delete another row.
Try something like this:
Public Sub DeleteRowsIfFound()
Dim originCell As Range, numberOfRowsToDelete As Integer
Dim blankCellLimit As Integer, numberOfBlankCells As Integer
Dim label As String, index As Long, n As Integer
Set originCell = Me.Range("A1")
blankCellLimit = 5
numberOfRowsToDelete = 2
index = 0
label = "test"
Do
If originCell.Offset(index, 0).Value = label Then
For n = 0 To numberOfRowsToDelete - 1
originCell.Offset(index + 1, 0).EntireRow.Delete
Next
ElseIf originCell.Offset(index, 0).Value = "" Then
numberOfBlankCells = numberOfBlankCells + 1
End If
index = index + 1
Loop While numberOfBlankCells < blankCellLimit
End Sub
This starts searching down column A starting at cell A1, and if it finds a cell with the value "test" then it will delete the next two rows following it.

For loop over text boxes in VB

For a = 1 To row
For b = 1 To clmn
Form1.Controls("A" & CStr(a) & "T" & CStr(b)).Text = table.Rows(a)(b)
Next
Next
I'm getting an error "System.NullReferenceException"
My text box names are A1T1, A1T2,A1T3,....
How to use for loop over these text boxes?
Eventhough when i start table index from 0,0 the error remains same
The DataTable use zero-based indexing. So your first row/column indices are 0, not 1.
Dim key As String
For a As Integer = 0 To (table.Rows.Count - 1)
For b As Integer = 0 To (table.Columns.Count - 1)
key = String.Format("A{0}T{1}", (a + 1), (b + 1))
If (Me.Controls.ContainsKey(key)) Then
Me.Controls.Item(key).Text = Convert.ToString(table.Rows(a)(b))
Else
Throw New ApplicationException("You need to create a control named: '" & key & "'")
End If
Next
Next