i have a problem, I'm currently making my project, my problem is i cant make my same order be on the same line if i ordered it at different time. for example i ordered 1 burger with cheese, then i ordered it again, what i want to happen in my list is that they'll just add the quantity i ordered instead of writing it down again. i have no idea what codes should i write, i tried different codes but it doesn't work so i deleted it. excuse my English. thank you.
These is what i want to avoid.
you didn't post any code!!!
Option Explicit
Sub UpdateProduct(sProduct As String, ByVal Qty As Long, ByVal Amnt As Currency)
Dim i As Long
i = GetStringIndex(List1, sProduct)
If (i = -1) Then ' there is no match?
List1.AddItem sProduct
List2.AddItem Str(Qty)
List3.AddItem Str(Amnt)
Else
List2.List(i) = Val(List2.List(i)) + Qty
List3.List(i) = Val(List3.List(i)) + Amnt
End If
End Sub
Function GetStringIndex(lst As ListBox, ByVal sItem As String) As Long
For GetStringIndex = 0 To lst.ListCount - 1
If lst.List(GetStringIndex) = sItem Then Exit Function
Next
GetStringIndex = -1
End Function
Related
I am following a tutorial on VBA static arrays. I want to make sure my thought process is correct for something simple that I wish to do.
I have code that picks up all 12 months and places it into a static array of type string. As practice, I wanted to see if it's possible to copy these values onto another location using another module that acts as "pasting" the months at the cursor selection, but not utilizing a public array. I'm new to VBA so perhaps my way of think about coding is flawed and for such a purpose, I should be using a publicly defined array.
Sub PopulateStaticArray()
Dim months(11) As String
Dim ndx As Integer
Dim xrow As Long
ndx = 0
xrow = 2
Do Until Cells(xrow, 1).Value = ""
months(ndx) = Cells(xrow, 1).Value
ndx = ndx + 1
xrow = xrow + 1
Loop
End Sub
What I want to achieve in a redundant fashion. (I'm essentially recreating the array from scratch).
Sub InsertMonthsArray()
Dim counter As Integer
Dim rowNum As Double
Dim colNum As Double
Dim months(11) As String
ActiveCell.Select
rowNum = ActiveCell.Row
colNum = ActiveCell.Column
months(0) = "January"
months(1) = "February"
months(2) = "March"
months(3) = "April"
months(4) = "May"
months(5) = "June"
months(6) = "July"
months(7) = "August"
months(8) = "September"
months(9) = "October"
months(10) = "November"
months(11) = "December"
For counter = 0 To UBound(months, 1)
Cells(rowNum, colNum).Value = months(counter)
rowNum = rowNum + 1
Next counter
End Sub
I read some posts about passing arrays, but I'm not sure if that's achieving what I'm looking for. Of course this is not actual project, but just to improve my understanding of the interaction between modules within VBA for Excel. I don't necessary need any code, but just the general conceptual guidance on if I should be using some other method to achieve this task (i.e. Public defined Array or Functions, etc.) Thank you.
#GSerg mentioned correctly
"You are not creating a static array inside PopulateStaticArray. If you want to pass an already existing array to InsertMonthsArray(), regardless of where it comes from, then yes, that should be Sub InsertMonthsArray(months() as string)"
You need to pass your array - declared at procedure level - as (implicit) ByRef argument, which means that you can assign month names to each array item within the called sub procedure createMonths so that the calling procedure can actually use them, for instance to write them to a vertical range (e.g. starting at cell A7).
Option Explicit ' declaration head of code module
Sub PopulateMonthArray()
'[0] declare array at procedure level
Dim months(11) As String ' equals Dim months(0 to 11)
'Dim months(1 To 12) As String ' alternative: declare a 1-based array
'[1] fill array items with month names passing array as (implicit) ByRef argument
createMonths months ' << call sub createMonths
'[2] write 1-dim array vertically to sheet (transposing output from a "flat" to a 2-dim array)
Sheet1.Range("A7").Resize(Rowsize:=12).Value = Application.Transpose(months)
End Sub
Sub procedure createMonths
As you define a 0-based array months(0 To 11) and months count usually from 1 to 12 I added functionality to allow to create a 1-based array as well.
Sub createMonths(months) ' equals Sub createMonths(ByRef months)
Dim countOffset As Long
countOffset = IIf(LBound(months), 0, 1) ' allow calculation of 0-based AND 1-based arrays
Dim i As Long
For i = LBound(months) To UBound(months) ' loop through each array element
months(i) = Application.Text(DateSerial(0, i + countOffset, 1), "mmmm")
Next i
End Sub
Simple alternative /Edit 2020-05-27
If your intention is, however to make your months array disponible within other procedures without need to declare it in each procedure (neither at a global scope nor within a class definition), you could simply profit from a simple workaround: insert a Property Get usable in standard modules, too - not only available in class modules btw. - But note that you don't preserve ("retain") the array actually, you would rebuild it and possibly in a better readable way.
Public Property Get Months()
Dim tmp(1 To 12) ' I'd prefer a 1-based months array :-)
createMonths tmp ' use the same procedure as above (or rebuild it code)
Months = tmp ' return the Get value
End Property
Sub AnyOtherProcedure()
'no further declaration needed
Debug.Print Months(1) ' ~> January
Debug.Print Join(Months, ", ") ' ~> January, February, ..., December
End Sub
I have Sheet1.ComboBox1 that I would like to fill with an array of values. This array is stored on Sheet2. This array is a list of all customers to be used in the excel file. All customers are listed in one single column.
Some customers appear more than once in the column. It varies by how many part numbers a customer has.
I would like to fill a Sheet1.ComboBox1 with this array, however, I don't want duplicate values.
I read online that I can convert the array into a collection which will automatically weed out duplicates.
I would like to take this collection and input it into the Sheet1.ComboBox1, however, upon some research, I've found that collections are read-only...(am I wrong in this conclusion?)
One strategy I saw was to convert the customer array into a collection and then back into a new simplified array. The hope is to store this new array into Sheet 3, then pull this array into ComboBox1.List. I've posted my code below of this attempt.
'Converts collection to an accessible array
Function collectionToArray(c As Collection) As Variant()
Dim a() As Variant: ReDim a(0 To c.Count - 1)
Dim i As Integer
For i = 1 To c.Count
a(i - 1) = c.item(i)
Next
collectionToArray = a
End Function
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection, customer
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long
CustomerArray() = Sheet2.Range("A5:A2000")
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
newarray = collectionToArray(ComboBoxArray)
Sheet3.Range("A1:A2000") = newarray
Sheet1.ComboBox1.List = Sheet3.Range("A1:2000")
I used ' CustomerArray() = Sheet2.Range("A5:2000") ' not because there are that many rows full of values in Sheet 2, rather, that I cover all bases when more customers are eventually added to the list. The total size of my Sheet 2 is currently A1:A110, but I want to future proof it.
When I run the code, the Array is successfully reduced and the new array is placed into Sheet3 with no duplicates. However, the first Customer entry is repeated after the last unique customer value is defined. (A46 is last unique customer, A47:A2000 its the same customer repeated)
Additionally, Sheet1.ComboBox1 remains empty.
Is anyone able to explain how to restrict the number of rows filled by 'collectionToArray' , instead of filling all 2000?
Also, where am I going wrong with filling the ComboBox1? Am I missing a command/function to cause the box to fill?
You don't need that function to make a New Array, seems Excessive to me.
Assigning to CustomerArray will take care of Future Additions in column
You can directly pass on the Collection value to ComboBox
You are missing On Error Goto 0 in your code after addition to Collection. That is making all to errors after that invisible and hard for you to identify which part of code is causing problems.
Here Try this:
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long
With Worksheets("Sheet2")
CustomerArray = .Range("A5:A" & .Range("A5").End(xlDown).row).Value
End With
On Error Resume Next
For i = LBound(CustomerArray) To UBound(CustomerArray)
ComboBoxArray.Add CustomerArray(i, 1), CustomerArray(i, 1)
Next
On Error GoTo 0
For Each Itm In ComboBoxArray
Worksheets("Sheet1").ComboBox1.AddItem Itm
Next
End Sub
First, you should assign your range dynamically to CustomerArray...
With Sheet2
CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
Then, you should disable error handling after you've finished adding the items to your collection. Since you did not do so, it hid the fact that your range reference in assigning the values to your listbox was incorrect, and that you didn't use the Value property to assign them. So you should disable the error handling...
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
On Error GoTo 0
Then, when transferring newarray to your worksheet, you'll need to transpose the array...
Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)
Then, as already mentioned, you should assign the items to your listbox with Sheet3.Range("A1:A2000").Value. However, since newarray already contains a list of the items, you can simply assign newarray to your listbox...
Sheet1.ComboBox1.List = newarray
So the complete code would be as follows...
Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection, customer As Variant
Dim CustomerArray() As Variant
Dim newarray() As Variant
With Sheet2
CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
On Error Resume Next
For Each customer In CustomerArray
ComboBoxArray.Add customer, customer
Next
On Error GoTo 0
newarray = collectionToArray(ComboBoxArray)
Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)
Sheet1.ComboBox1.List = newarray
End Sub
it could be achieved in a number of ways. using collection or dictionary object. i am just presenting simple method without going through collection or dictionary since only 5000 rows is to be processed. it could be further shortened if used directly with combo box without using OutArr. As #Domenic already answered it with explanations, may please go along with that solution.
Option Explicit
Sub test()
Dim InArr As Variant, OutArr() As Variant
Dim i As Long, j As Long, Cnt As Long
Dim have As Boolean
InArr = ThisWorkbook.Sheets("sheet2").Range("A5:A2000")
ReDim OutArr(1 To 1)
Cnt = 0
For i = 1 To UBound(InArr, 1)
If InArr(i, 1) <> "" Then
have = False
For j = 1 To UBound(OutArr, 1)
If OutArr(j) = InArr(i, 1) Then
have = True
Exit For
End If
Next j
If have = False Then
Cnt = Cnt + 1
ReDim Preserve OutArr(1 To Cnt)
OutArr(Cnt) = InArr(i, 1)
End If
End If
Next i
Sheet3.Range("A1").Resize(UBound(OutArr)).Value = Application.Transpose(OutArr)
Sheet1.ComboBox1.Clear
Sheet1.ComboBox1.List = OutArr
Debug.Print Sheet1.ComboBox1.ListCount
End Sub
My Goal is to take two rows(FirstName and Surname) Convert them to a single Array of "FirstName, Surname".
This is my terrible code i eventually put together
Private Sub Search_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'DbaPatientDataSet.tblPatientData' table. You can move, or remove it, as needed.
Me.TblPatientDataTableAdapter.Fill(Me.DbaPatientDataSet.tblPatientData)
listFirst.DataSource = Me.TblPatientDataBindingSource
listFirst.DisplayMember = "FirstName"
listLast.DataSource = Me.TblPatientDataBindingSource
listLast.DisplayMember = "Surname"
Dim Lenth As Integer = Me.listFirst.Items.Count - 1
Dim count As Integer = 1
Dim ArrFirst(Lenth) As String
Dim ArrLast(Lenth) As String
For count = 1 To Lenth
ArrFirst(count) = listFirst.Items(count).ToString
ArrLast(count) = listLast.Items(count).ToString
Next count
count = 1
For count = 1 To Lenth
arrFullName(count) = ArrLast(count) & ", " & ArrFirst(count)
Next count
'Arrays Set =====================================================
But with this code i get an Array of
`"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
`
As you can see
Here
There must be an easy way to convert both DataRows to strings then concatenate them together in an array
I am going to search this array using a Binary Search to find a desired name
Thanks
First, I think you are confusing your rows and your columns. You have 2 columns. I went directly to full name but I think you can break it out if you need to.
Dim arrNames(ListBox1.Items.Count - 1) As String
For i As Integer = 0 To ListBox1.Items.Count - 1
arrNames(i) = $"{ListBox1.Items(i)} {ListBox2.Items(i)}"
Next
For Each item In arrNames
Debug.Print(item)
Next
The string with the $ in front is an interpolated string. Sort of an improvement to String.Format.
I know there is an answer but for now you could go direct to the data table to get what you need.
Dim arrNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
Dim dt As DataTable = DbaPatientDataSet.Tables(0)
For Each row As DataRow In dt.Rows
arrNames(i) = $"{row("Surname")}, {row("FirstName")}"
i += 1
Next
For Each item In arrNames
Debug.Print(item)
Next
'assume the names of your columns are Surname and FirstName
If I run your code up, I get the result you are looking for, so I'm not sure what you are missing. In saying that though, you are making things hard on yourself by messing around with arrays :). Just use the dataset rows directly - they are strongly typed and you can check for nulls etc as needed... something like this;
Dim fullNames As New List(Of String) '-- or you could fill your array.
For Each row As DbaPatientDataSet.tblPatientDataRow In ds.tblPatientData
fullNames.Add(row.Surname & ", " & row.FirstName)
Next
Just looking at what you are trying to achieve, if it was me, I would be bringing back the formatted data in my query that fills the dataset i.e. a third, FullName, column.
It has been in the back of my mind. Finally got it for the List Box directly.
Dim arrFullNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
For Each item As DataRowView In ListBox1.Items
arrFullNames(i) = $"{DirectCast(item("Surname"), String)}, {DirectCast(item("Firstname"), String)}"
i += 1
Next
For Each item As String In arrFullNames
Debug.Print(item)
Next
Here in my code, i have a database which has table of my applicants. As you will see in the code below, i want to get the number of rows from my command text and transfer it to the string "abc"
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
myr.Close()
mycom.Connection = cn
mycom.CommandText = "SELECT Count(Cellphone) FROM tbl_applicant where Gender='Female';"
myr = mycom.ExecuteReader
Dim abc As String
If myr.Read Then
abc = myr(0)
End If
myr.Close()
On the code Below i used the abc as the number of data i must acquire. Then i used the new query to get the values i wanted to and transfer them to a String Array, as you can see I Redim the universal variable Numb to abc to have its array boundery.
mycom.CommandText = "SELECT Cellphone FROM tbl_applicant where Gender='Female';"
myr = mycom.ExecuteReader
ReDim Numb(abc)
If myr.Read Then
For i As Integer = 1 To abc.ToString - 1
LOT = myr(0).ToString
LOT = LOT + (myr(i).ToString + ",") <- this is where i get the error it says that index is our of range.
Numb = LOT.Split(",")
Next
End If
In this code below, i want the values of Variable Numb() to be transferred to a multiline textbox
Dim sbText As New System.Text.StringBuilder(500)
For i As Integer = 0 To Numb.Length - 2
' This will convert the number to a string, add it to the stringbuilder
' and then append a newline to the text buffer
sbText.AppendLine(Numb(i))
Next i
' Now move the buffer into the control
TextBox1.Text = sbText.ToString()
End Sub
The end value i must see in the textbox should be like
11111111111
11111111112
11111111113
11111111114
and so forth, please try to understand the numbers i am referring it to real phone numbers. Any help with the problem or solution maybe.. Thanks
I don't think you need to first query the db to get the count of records before then going back to the db to get the phonenumbers, you could just do this:
mycom.CommandText = "SELECT Cellphone FROM tbl_applicant where Gender='Female';"
myr = mycom.ExecuteReader
While myr.Read()
TextBox1.Text = TextBox1.Text & myr(0) & Environment.NewLine
End While
No need for array's or List's
While this is just a rough guide and an attempt at understanding your issue, try the code and see if it works for you.
I have an array of lines and I want at some point to erase some of them.
Here's a sample of the code:
Dim canvas As New Microsoft.VisualBasic.PowerPacks.ShapeContainer
Dim lines(20) As PowerPacks.LineShape
Dim it As Integer = 0
Private Sub GoldenSpi_Load(sender As Object, e As EventArgs) Handles MyBase.Load
canvas.Parent = Me
lines.Initialize()
iter.Text = 0
End Sub
Private Sub iter_TextChanged(sender As Object, e As EventArgs) Handles iter.TextChanged
If (it > iter.Text And iter.Text <> 0) Then
ReDim Preserve lines(iter.Text - 1)
End If
If (it <> iter.Text) Then
it = iter.Text
End If
For i As Integer = 1 To iter.Text
lines(i - 1) = New PowerPacks.LineShape(canvas)
lines(i - 1).StartPoint = pA(i)
lines(i - 1).EndPoint = pB(i)
lines(i - 1).BringToFront()
Next
End Sub
After I execute the program, the lines are created. But when I give a value to my textbox that is smaller than the variable 'it', it justs delete the last line and not the rest. Also I saw while debugging that the size of array is reduced. So that means that the contents beyond the size are still kept? Why is that?. Any help is appreciated. Thanks.
EDIT: I tried to create the List like this:
Dim lines As New Generic.List(Of PowerPacks.LineShape)
Private Sub iter_ValueChanged(blabla) Handles iter.ValueChanged
If (it > iter.Value And iter.Value <> 0) Then
lines.RemoveRange(iter.Value - 1, lines.Count - iter.Value)
End If
For i As Integer = 1 To iter.Value
InitPoints()
If i - 1 = lines.Count Then
Dim line As New PowerPacks.LineShape
With line
.StartPoint = pA(i)
.EndPoint = pB(i)
.BringToFront()
.Parent = canvas
End With
lines.Add(line)
End If
Next
End Sub
But still the lines are visible in the form. I debugged it and saw that the list size decreased. The same problem when I had an array. What is going?...
I recommend changing iter.Text to cint(iter.Text), as there is a chance it's comparing both values as text (which is compared differently).
I'd also recommend changing Dim lines(20) As PowerPacks.LineShape to Dim lines As new generic.list(of PowerPacks.LineShape)
That way you don't have to worry about ReDim Preserve (which can be slow when you do it in a loop), and you can easily insert items into any index if you whish
You should use Option Strict On in your project, in order to avoid implicit conversion between types which can give you errors or, worse, unexpected behaviors.
On the other hand, you should not have a TextBox to store numbers unless there is a need. Use a NumericUpDown, for example. Take a look at the MSDN Documentation.
And now, for the array, I recommend using a List, which has all the methods implemented that you need to handle the elements, and has a .ToArray() method that will give you the array if needed.
Try something like this:
Dim it As Integer = 0
Dim lines As New List(Of PowerPacks.LineShape)()
Sub iter_TextChanged(sender As Object, e As EventArgs) Handles iter.TextChanged
Dim iTxt As Integer
Try
iTxt = Integer.Parse(iter.Text)
If it > iTxt AndAlso iTxt <> 0 Then
End If
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
I was going to write to you an example, but I realized that I don't know exactly what you're trying to do. Could you explain?