I ran into the following issue when dealing with adding to variable array sizes. The loop runs one time more then it should essentially. But I'm curious as to what would cause this behavior? Am I not quite understanding how the loop exit functions are being called?
Here's the code:
Module Module1
Sub Main()
Dim num(-1)
Dim i = 0
Console.WriteLine("Input numbers to be added, q to stop:")
Dim input
Dim total = 0
Do
ReDim Preserve num(UBound(num) + 1) : num(UBound(num)) = i 'resize the array each time before an element is added.
input = Console.ReadLine
If IsNumeric(input) Then 'attempt to break loop on non numeric input
num(i) = CInt(input)
i += 1
Else
Exit Do
End If
Loop
total = 0
For Each n In num
total += n
Next
Console.WriteLine(Join(num))
Console.WriteLine("Total: " & total)
Console.ReadLine()
For input: 1 2 3 4 5 q, the output I get is:
1 2 3 4 5 5
Total: 20
It adds the last element twice, which is interesting as it is not only running twice but somehow using the last numeric input even though the final input was not numeric. Does anyone know why that would be?
You both (jnb92, PankajJaju) should not grow the array before you are sure the input is numerical and has to be stored.
Dim input
Do
input = Console.ReadLine()
If IsNumeric(input) Then 'attempt to break loop on non numeric input
ReDim Preserve num(UBound(num) + 1)
num(UBound(num)) = CInt(input)
Else
Exit Do
End If
Loop
Update wrt comment:
Your
ReDim Preserve num(UBound(num) + 1) : num(UBound(num)) = i
assigns i to num for each input; your
num(i) = CInt(input)
overwrites that with your numerical input, but not for the terminating "q". So for your (one and only?) test case, the spurious last elemement is (accidentially) 5.
I've used your script and tried to create a working solution
Dim num, input, total, i
num = Array()
i = 0
Do
input = Inputbox("Input numbers to be added, q to stop:")
If IsNumeric(input) Then 'attempt to break loop on non numeric input
ReDim Preserve num(UBound(num) + 1) 'resize the array each time before an element is added.
num(i) = CInt(input)
i = i + 1
Else
Exit Do
End If
Loop
total = 0
For Each n In num
total = total + n
Next
msgbox Join(num)
msgbox "Total: " & total
Edit - Updated answer based on #Ekkehard.Horner comments
Related
This is my first post. I have been using VBA for a month now, and I am trying to populate an array with dates based on a user defined range. For example, the user will input: 05/01/2001 - 05/21/2001. There for I am trying to populate an array with all of the days from start to end, with this example it will be 21 dates. When I print out the array, I am only getting the odd days, and not the even days. Can anyone help with this? Thanks!
I am usind the DateDiff() function to get the number of days between the start and end dates to determine the number of dates I have to include inside of the array.
temp_csv_file_count is the number of values inside the array, input_start_date and input_end_date are strings, ignore the state, that has to do with something else.
temp_csv_file_count = DateDiff("d", input_start_date, input_end_date)
temp_csv_file_count = temp_csv_file_count + 1
Dim temp_date() As String
ReDim temp_date(0 To temp_csv_file_count) As String
Dim i As Integer
For i = 0 To temp_csv_file_count
temp_date(i) = DateAdd("d", i, input_start_date)
i = i + 1
Next i
msg = "File Count: " & temp_csv_file_count & ", State: " & temp_state
MsgBox msg
Dim array_contents As String
Dim j As Integer
For j = 0 To temp_csv_file_count
array_contents = array_contents + temp_date(j) + vbNewLine
Next j
MsgBox "the values of my dynamic array are: " & vbNewLine & array_contents
Actual:
05/01/2001,
05/03/2001,
05/05/2001,
05/07/2001,
05/09/2001,
05/11/2001,
05/13/2001,
05/15/2001,
05/17/2001,
05/19/2001,
05/21/2001
For i = 0 To temp_csv_file_count
temp_date(i) = DateAdd("d", i, input_start_date)
'i = i + 1 'THIS IS WHY
Next i
A for loop will iterate 1 at a time, unless specified in the Step (you haven't listed the step, so it assumes 1), you are telling it to add 1 before the loop itself iterates (via Next i).
For i = 0 To temp_csv_file_count Step 1 'added the step to ensure it is understood
temp_date(i) = DateAdd("d", i, input_start_date)
Next i
For-each loop each time increase the value of i by one (if you do not change it) by its self. There is no reason to use i = i + 1.
For further details:
If you want to increase the value of i by two you could use Step 2:
Example:
For i = 0 To temp_csv_file_count Step 2
temp_date(i) = DateAdd("d", i, input_start_date)
Next i
If you want to start the loop from the bottom to the top OR if loop aiming to delete:
Example:
For i = temp_csv_file_count To 0 Step -1
temp_date(i) = DateAdd("d", i, input_start_date)
Next i
I'm trying to code a program that has two sections depending on which of two buttons has been pressed.
The first section is the bit that is working, the user presses the first button labeled "unsort", this triggers a loop which displays an input box asking for a random number 8 times. These 8 numbers are stored in an array.
However it is the second section I'm struggling with; the second button is labeled sort and should output the numbers the user just entered using the first button is order, smallest to largest. I understand that a bubble sort must be used here and that a loop within a loop must also be used however it is the content of these loop that I don't understand. Since my original post I've edited the post to include some code in the loop I was previously stuck with, however it still isn't producing the desired output (all numbers in order) but is instead just outputting the numbers in a seemingly random order
The code is posted below with annotations:
Public Class BubbleSort1
Dim Bubble(8) As Integer
Dim UnsortedList As String
Dim n As Integer
Dim SortedList As String
Dim temp As String
Private Sub btnUnsort_Click(sender As Object, e As EventArgs) Handles btnUnsort.Click
n = 8 ' number off values on array
For i = 1 To n ' when i is between 1 and size of array
Bubble(i) = InputBox("Enter Number") ' User inputs a number
UnsortedList = UnsortedList & " " & Bubble(i) & vbNewLine ' number is added to the unsorted list variable
Next i
lblUnsort.Text = UnsortedList ' outputs the array
End Sub
Private Sub btnSort_Click(sender As Object, e As EventArgs) Handles btnSort.Click
For i = 1 To n - 1 ' When i is between 1 and the array size - 1 (8-1):
For j = 1 To n - 1 ' Second loop - when j is between 1 and the array size - 1 (8-1):
If Bubble(j) > Bubble(j + 1) Then ' if bubble value j is greater than value j - 1:
temp = Bubble(j)
Bubble(j) = Bubble(j + 1) ' These lines are supost to order the numbers but aren'r currently doing so
Bubble(j + 1) = temp
SortedList = SortedList & Bubble(j) & vbNewLine ' Adding the number in order to a variable
End If
Next j
Next i
lblSort.Text = SortedList ' outputting the ordered numbers
End Sub
End Class
As is pointed out in the code, the section of this code that orders the numbers is just putting them in a random order rather than actually ordering them.
With your updated code which now includes the swapping of array elements, you are building the string which shows the sorted array too soon: it will show the workings rather than the final result.
All you need to do is build the string once the array is in order:
Private Sub btnSort_Click(sender As Object, e As EventArgs) Handles btnSort.Click
' Bubble sort the array...
For i = 1 To n - 1 ' When i is between 1 and the array size - 1 (8-1):
For j = 1 To n - 1 ' Second loop - when j is between 1 and the array size - 1 (8-1):
If Bubble(j) > Bubble(j + 1) Then ' if bubble value j is greater than value j - 1:
temp = Bubble(j)
Bubble(j) = Bubble(j + 1)
Bubble(j + 1) = temp
End If
Next j
Next i
'lblSort.Text = String.Join(vbNewLine, Bubble.Skip(1)) ' an easy one-liner
' Create a string to show the sorted array...
SortedList = "" ' clear it out in case it was used previously
For i = 1 To n
SortedList = SortedList & Bubble(i).ToString()
If i < n Then ' only add a newline if it isn't the last element
SortedList = SortedList & vbNewLine
End If
Next
lblSort.Text = SortedList
End Sub
I put the .ToString() in there in anticipation of you explicitly converting the input strings into numbers; strictly speaking, the & operator will convert its arguments into strings but I prefer to make it obvious in the code.
As your code is, there is an implicit conversion from the input (a string of digits) into an integer (the type of the array elements). While this seems convenient, it can be a problem if VB guesses the wrong conversion for you. There is a way to tell it to let you know if the types of variables don't match: put Option Strict On as the very first line and it will even give you suggestions on what needs to be done to put it right.
If you want to prompt the user for the input, then you will first need to either get a numeric value using a control like a NumericUpDown or you will need to convert the String value to an Integer value using Integer.TryParse. Also, keep in mind that arrays in VB.Net have a 0 based index, so they start at 0, not at 1.
In terms of the Bubble Sort algorithm, you'll need a nested loop like you have with i and j, only your inner-nested loop (j) needs to iterate from the beginning of the array to the second to last item (0 to n-2). Inside of the nested loops, you would compare if the currently iterated value is greater than (or less than depending on which value you want to swap) than the next value. If so, then you'd just reassign the values at the currently iterated index.
Here is a console application example that I whipped up, it does not prompt the user for random values, rather it simply gets a collection of random values and then performs the Bubble Sort:
Private Function BubbleSort(ByVal values() As Integer) As Integer()
'Declare placeholder variables to use in the iterations
Dim temp As Integer
For outterIndex As Integer = 0 To values.Length - 1
For innerIndex As Integer = 0 To values.Length - 2
If values(innerIndex) > values(innerIndex + 1) Then
temp = values(innerIndex + 1)
values(innerIndex + 1) = values(innerIndex)
values(innerIndex) = temp
End If
Next
Next
Return values
End Function
Private r As New Random()
Private Function RandomNumbers(ByVal range As Integer) As Integer()
'Throw an exception if the value is less than 1
If range < 1 Then Throw New ArgumentOutOfRangeException("The range cannot be less than 1")
'Return a collection of random numbers
Return Enumerable.Range(1, range).Select(Function(i) r.Next()).ToArray()
End Function
Fiddle: Live Demo
I am struggling with a basic problem in VBA and would appreciate some help. I want to define a function which returns an array from a range without blanks, as shown below:
So when I call the function in the European Option cell, the function should return an array without any blanks, like on the right hand side.
This is the code I have so far:
Function portfolioX(N)
Dim MyArray(3)
Dim i As Integer
counter = 1
For i = 1 To N
If IsEmpty(i) Then
Next i
Else
portfolio = MyArray
MyArray (counter)
counter = counter + 1
Next i
End If
End Function
I am a newbie to VBA, so this could be completely wrong. Thanks!
If statement and loop are blocks of code. You can not interlace blocks of code.
Function portfolioX(N)
For i = 1 To N ' Block 1 starts
If IsEmpty(i) Then ' Block 2 starts
Next i 'Block 1 can't loop back because Block 2 has't closed
Else
portfolio = MyArray
MyArray (counter)
counter = counter + 1
Next i 'Block 1 can't loop back because Block 2 has't closed
End If ' Block 2
End Function
When coding it is code practice to write the complete loop structure then fill in the inner code.
I would write the For loop first
For i = 1 to N
next i
Next comes the If block
For i = 1 To N
If IsEmpty(i) Then
End If
Next i
And finally
Function portfolioX(N)
Dim MyArray(3)
Dim i As Integer
counter = 1
For i = 1 To N ' Block 1 Starts
If IsEmpty(i) Then Block 2 Starts
portfolio = MyArray
MyArray (counter)
counter = counter + 1
End If ' Block 2 Closes
Next i 'If the Loop Condition is meet, Block 1 Closes, else i is incremented and the loop starts over
End Function
Given what you are asking for, I've written a quick sub that will take whatever range you have highlighted and paste the values with the blank cells removed at the end of the row. Hopefully this can give you a start towards what you are hoping to accomplish.
Sub RemoveBlanks()
Dim OriginalRange As Range, WorkCell As Range, PasteCol As Integer
Set OriginalRange = Selection.Rows(1) 'Ensures only one row of data is selected
PasteCol = Range(Cells(OriginalRange.Row, ActiveSheet.UsedRange.Columns.Count + 2).Address).End(xlToLeft)
For Each WorkCell In OriginalRange
If Not IsEmpty(WorkCell) Then
Cells(OriginalRange.Row, PasteCol).Value = WorkCell.Value
PasteCol = PasteCol + 1
Next WorkCell
End Sub
Based on your question and comments in that thread, I understand that you wish to take a given range (supplied to the procedure) and print all non-empty values to some range starting on the same row in column R (the 18th column).
In a comment, you supply the ranges A1:A13 and A18:A21, but those do not match with your screenshot. I assume you meant row 1 (or some arbitrary row), columns 1 to 13 and columns 18 to 21.
Here is a solution to that problem:
Sub arrayPaster(rng As Range)
Dim s() As Variant, r() As Variant, j As Integer
ReDim r(1 To 1, 1 To 1)
s = rng.Value
j = 1
For i = 1 To UBound(s, 2)
If s(1, i) <> "" Then
ReDim Preserve r(1 To 1, 1 To j)
r(1, j) = s(1, i)
j = j + 1
End If
Next i
Range("R" & rng.Row).Resize(1, UBound(r, 2)).Value = r
End Sub
I have input array {{1,4}, {1,3}, {1,4,7}}
Dim array1() As Long
ReDim array1(3, 3)
array1(1, 1) = 1
array1(1, 2) = 4
array1(2, 1) = 1
array1(2, 2) = 3
array1(3, 1) = 1
array1(3, 2) = 4
array1(3, 3) = 7
I would like to have output array (which is length of each subarray) {2,2,3}
I am thinking to use for loop as following
Dim i As Long
i = UBound(array1, 1)
Dim outputarray() As Long
ReDim outputarray(i) As Long
For j = 1 To i
outputarray(i) = UBound(array1(i), 2) 'ERROR APPEAR
Next j
i added Option Base 1
The length of each subarray stay the same, its always 3 in your case. Your redim has defined the number you want to get. So there's no point trying to retrieve it like you want to do.
The fact that you don't move any values in
array1(1, 3)
array1(2, 3)
doesn't affect the dimensions of your array. You'll find values in these what-you-think-empty array's cells, and it will be 0 because you declared your array as long. If you had declared it as string, you would find a blank string in them, neither null nor "nothing".
You have input array {{1,4,0}, {1,3,0}, {1,4,7}}
If your aim is to find which elements of your array are 0 because you didn't moved anything in them, that's another story not related to the length of your array.
I agree with Thomas' answer above.
If you do find yourself interested in knowing the number of populated array values in the array, you might consider the following:
Start with the first row, and the right-most value in that array. So your for loop would actually be two loops - one to go through the first dimension, and one to go through the second dimension.
Move left through the array until you run into a non-zero value. Keep a count of the total values that are zero. When you run into a non-zero value, subtract the total zero values from the second dimension of the array. This will give you the "length" that you were looking for before.
So for example:
Dim i As int
Dim j As int
Dim h As int
Dim w As int
h = UBound(array1, 1)
w = UBound(array1, 2)
Dim rowVals as int
Dim arrVals as int
For i = 0 To h
rowVals = 0
For j = w to 0 Step -1
if array1(i,j) = 0 Then
exit for
else
rowVals = rowVals + 1
end if
Next
arrVals = arrVals + rowVals
Next
I am looping through some data (only 8 values) in an Excel range from VBA, but I seem to be getting a 'phantom' empty array value in the middle.
Here is how I build the array. The range that it loops through results in 2 values being found, i.e. 2 values = 'rad'.
' arRoPtsXY is a 2D array
counter2 = UBound(arRoPtsXY, 2)
Dim arSecPtCt()
loopCtr = 0
For i = 1 To counter2
rad = Sqr((secCX - arRoPtsXY(1, i)) ^ 2 + (secCY - arRoPtsXY(2, i)) ^ 2)
If rad = secR Then
ReDim Preserve arSecPtCt(i)
arSecPtCt(loopCtr) = i
loopCtr = loopCtr + 1
End If
Next i
But when I perform this:
For a = LBound(arSecPtCt) To UBound(arSecPtCt)
Debug.Print arSecPtCt(a)
Next a
I get this output:
1
3
'end
Note, above, there are 2 blank spaces being output (after 3, I added 'end to show the spaces here), like the array 'space' exists, but it is empty.
If I do a debug.print UBound(arSecPtCt) I get '3', meaning 0,1,2,3 occupied array 'spaces'.
I just want my array to be:
1
3
As it is only the 1st and 3rd value that = 'rad'.
If I debug.print i during the if loop, it only outputs the 1 and 3, no spaces, so the loop seems to work, but I am just getting these extra blanks.
Hope someone can put me out my misery.
Many thanks in advance.
Jon
Try changing:
ReDim Preserve arSecPtCt(i)
to
ReDim Preserve arSecPtCt(loopCtr)