I keep getting a "Index was outside the bounds of the array" error when trying to run my code. It points to this line.
If order(i).purchaseMethod = "S" Then
It is in this context
Sub calculatePopularPayment(ByRef popularMethod, ByVal order)
'declares the subclass-specific variables
Dim i As Integer = 0
Dim officeCount As Integer = 0
Dim websiteCount As Integer = 0
For i = 0 To 299
If order(i).purchaseMethod = "S" Then
officeCount = officeCount + 1
ElseIf order(i).purchaseMethod = "W" Then
websiteCount = websiteCount + 1
End If
i = i + 1
Next
Can anybody help me out here?
A For-loop does not need to be incremented manually, the loop itself odes it for you:
For i = 0 To 299
If order(i).purchaseMethod = "S" Then
officeCount = officeCount + 1
ElseIf order(i).purchaseMethod = "W" Then
websiteCount = websiteCount + 1
End If
Next
Of course this will still throw this exception if there are less than 300 items in the array. If you want to iterate all items you should use:
For i = 0 To order.Length - 1
...
Next
If you want to skip every other element you should use Step:
For i = 0 To 299 Step 2
....
Next
Side-note: i strongly recommend to set Option Strict to On.
Related
I am getting the "next without for" error. I checked other questions on this and looked for any open if statements or loops in my code, but could find none. I'm need an extra set of eyes to catch my error here.
I am trying to loop through this code and advance the torque value 3 times each times it gets to the 30th i.
'This is Holzer's method for finding the torsional natural frequency
Option Explicit
Sub TorsionalVibrationAnalysis_()
Dim n As Integer 'position along stucture
Dim m As Integer
Dim i As Long 'frequency to be used
Dim j As Variant 'moment of inertia
Dim k As Variant 'stiffness
Dim theta As Long 'angular displacement
Dim torque As ListRow 'torque
Dim lambda As Long 'ListRow 'omega^2
Dim w As Variant
Dim s As Long
'equations relating the displacement and torque
n = 1
Set j = Range("d2:f2").Value 'Range("d2:f2").Value
Set k = Range("d3:f3").Value
'initial value
Set w = Range("B1:B30").Value
For i = 1 To 30
'start at 40 and increment frequency by 20
w = 40 + (i - 1) * 20
lambda = w ^ 2
theta = 1
s = 1
Do While i = 30 & s <= 3
torque = lambda * j(1, s)
s = s + 1
End
m = n + 1
theta = theta - torque(i, n) / k(n)
torque(i, m) = torque(i, n) + lambda * j(m) * theta
If m = 4 & i < 30 Then
w(i) = 40 + (i - 1) * 20
lambda = w(i) ^ 2
ElseIf m = 4 & i >= 30 Then
Cells([d], [5+i]).display (i)
Cells([e], [5+i]).display (theta)
Cells([f], [5+i]).display (torque)
Else
End If
If m <> 4 Then
n = n + 1
End If
Next i
End Sub
You are trying to terminate your While with an End instead of Loop
Try changing your End to Loop in your Do While loop. I think you are terming the loop when you hit that End
Proper indentation makes the problem rather apparent.
You have:
For i = 1 To 30
'...
Do While i = 30 & s <= 3
'...
End
'...
If m = 4 & i < 30 Then
'...
ElseIf m = 4 & i >= 30 Then
'...
Else
End If
If m <> 4 Then
'...
End If
Next i
But run it through Rubberduck's Smart Indenter and you get:
For i = 1 To 30
'...
Do While i = 30 & s <= 3
'...
End
'...
If m = 4 & i < 30 Then
'...
ElseIf m = 4 & i >= 30 Then
'...
Else
End If
If m <> 4 Then
'...
End If
Next i
End Sub
Notice how the End other answers are pointing out, is clearly not delimiting the Do While loop.
The Next i is inside the Do While block, which isn't terminated - when the VBA compiler encounters that Next i, it doesn't know how it could possibly relate to any previously encountered For statement, and thus issues a "Next without For" compile error.
Use an indenter.
I am trying to add values from LANG_OBJ.TEXT to DataTableRow.
While adding i am getting a error:
There is no row at position 0
dtsaveTranslate = checkTranslateValues()
lang_id_text CType(Controls.Find("txt_id"True).FirstOrDefault(),TextB`enter code here`ox)
lang_de_text = CType(Controls.Find("txt_de", True).FirstOrDefault(), TextBox)
lang_row = dtsaveTranslate.NewRow()
lang_row("de") = lang_de_text
For Each row As DataRow In dtlang.Rows
lang_iso = Convert.ToString(row("ISO"))
lang_obj = CType(Controls.Find("txt_" + lang_iso, True).FirstOrDefault(), TextBox)
Dim len As Integer = lang_obj.Text.Length
Dim count_de As Integer = lang_de_text.Text.Length
progress.ProgressValue = len + 1
If Convert.ToString(row("isUbersetzen")) = "True" AndAlso lang_iso <> "de" Then
lang_obj.Text = lanClass.GoogleApiTranslate("de", Convert.ToString(row("ISO")), lang_de_text.Text.Trim())
lang_row(lang_iso) = lang_obj.Text
Else
count_txt = 0
End If
Next
dtsaveTranslate.Rows.Add(lang_row)
First you need to make sure that dtLang has rows and then try to loop them!
You need to make sure that dtLang is loaded with data. You should research why it doesn't contain any rows first. From the code above I can't see how the rows are loaded in there. Therefore, the proper check should start with:
If dtlang.Rows.count > 0 '<--- Added a check before looping
For Each row As DataRow In dtlang.Rows
lang_iso = Convert.ToString(row("ISO"))
lang_obj = CType(Controls.Find("txt_" + lang_iso, True).FirstOrDefault(), TextBox)
Dim len As Integer = lang_obj.Text.Length
Dim count_de As Integer = lang_de_text.Text.Length
progress.ProgressValue = len + 1
If Convert.ToString(row("isUbersetzen")) = "True" AndAlso lang_iso <> "de" Then
lang_obj.Text = lanClass.GoogleApiTranslate("de", Convert.ToString(row("ISO")), lang_de_text.Text.Trim())
lang_row(lang_iso) = lang_obj.Text
Else
count_txt = 0
End If
Next
End If
the code to generate no. of arrays from one is working..I'm try to make some change to it like below
Function myarray(ByVal arra1() As Integer, ByVal arran() As Integer, ByVal arrNumber As Integer) As Integer()
arran = arra1.Clone()
For i As Integer = 0 To arra1.Length - 1
If i = (arrNumber - 1) Then ' IF arrNumber is 1 then +1 to index 0, If it is 2 then +1 to index 1
arran(i) = arra1(i) + 1
'If there are two duplicate value make on of them zero at a time
For k = 0 To arran.Length - 1
For j = k + 1 To arran.Length - 1
If arran(k) = arran(j) Then
arran(k) = 0
End If
'make any value great than 11 zero
If arran(i) > 11 Then
arran(i) = 0
End If
Next
Next
Else
arran(i) = arra1(i)
End If
Next
'Print the array
For i = 0 To arran.Length - 1
Console.Write(arran(i) & " ")
Next
Console.WriteLine()
Return arran
End Function
what I really need is to decompose for example {1,4,5,5} to be {1,4,0,5} and then {1,4,5,0} the above code generate only {1,4,0,5}
I haven't tested this, but I believe the following code will do what you want. Based on your comments, I've changed the function to return all resulting arrays as an array of arrays, rather than requiring the index to change as an input and returning one array. I also ignored matches of 0, as the conditions you describe don't seem designed to handle them. Because of it's recursion, I think this approach will successfully handle input such as {3, 3, 3, 3}.
Public Function jaggedArray(ByVal inputArray() As Integer) As Integer()()
If inputArray Is Nothing Then
Return Nothing
Else
Dim resultArrays()(), i, j As Integer
Dim arrayMax As Integer = inputArray.GetUpperBound(0)
If arrayMax = 0 Then 'prevents errors later if only one number passed
ReDim resultArrays(0)
If inputArray(0) > 11 Then
resultArrays(0) = {1}
ElseIf inputArray(0) = 11 Then
resultArrays(0) = {0}
Else
resultArrays(0) = {inputArray(0) + 1}
End If
Return resultArrays
End If
For i = 0 To arrayMax
Dim tempArray() As Integer = inputArray.Clone
For j = 0 To arrayMax
If tempArray(j) > 11 Then
tempArray(j) = 0
End If
Next
If tempArray(i) = 11 Then
tempArray(i) = 0
Else
tempArray(i) += 1
End If
splitArray(resultArrays, tempArray)
Next
Return resultArrays
End If
End Function
Private Sub splitArray(ByRef arrayList()() As Integer, ByVal sourceArray() As Integer)
Dim x, y As Integer 'positions of matching numbers
If isValid(sourceArray, x, y) Then
If arrayList Is Nothing Then
ReDim arrayList(0)
Else
ReDim Preserve arrayList(arrayList.Length)
End If
arrayList(arrayList.GetUpperBound(0)) = sourceArray
Else
Dim xArray(), yArray() As Integer
xArray = sourceArray.Clone
xArray(x) = 0
splitArray(arrayList, xArray)
yArray = sourceArray.Clone
yArray(y) = 0
splitArray(arrayList, yArray)
End If
End Sub
Private Function isValid(ByRef testArray() As Integer, ByRef match1 As Integer, ByRef match2 As Integer) As Boolean
For i As Integer = 0 To testArray.GetUpperBound(0) - 1
If testArray(i) > 11 Then
testArray(i) = 0
End If
For j As Integer = i + 1 To testArray.GetUpperBound(0)
If testArray(j) > 11 Then
testArray(j) = 0
End If
If testArray(i) = testArray(j) AndAlso testArray(i) > 0 Then 'added second test to prevent infinite recursion
match1 = i
match2 = j
Return False
End If
Next
Next
match1 = -1
match2 = -1
Return True
End Function
How to make first letter in upper case while pressing tab or space in vb 6.0 ?
My code is as follows
txtFirstName.Text = UCase$(txtFirstName.Text)
but it doesn't change after tab or space
It's just simple just do this in the text box keypress events...
Private sub textbox_keypress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Use the LostFocus event
Private Sub yourTextBox_LostFocus()
With yourTextBox
'first letter in upper case, the rest, untouched.
.Text = UCase(Mid(.Text, 1, 1)) & Mid(.Text, 2, Len(.Text))
End With
End Sub
Apply the same logic to the KeyDown event and check if the pressed key is the space key.
Private Sub yourTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Then
With yourTextBox
'first letter in upper case, the rest, untouched.
.Text = UCase(Mid(.Text, 1, 1)) & Mid(.Text, 2, Len(.Text))
.SelStart = Len(.Text) 'put the cursor at the end of the textbox...
End With
End If
End Sub
StrConv Function
Returns a Variant (String) converted as specified.
Syntax
StrConv(string, conversion, LCID)
The StrConv function syntax has these named arguments:
Part Description
string Required. String expression to be converted.
conversion Required. Integer. The sum of values specifying the type of conversion to perform.
LCID Optional. The LocaleID, if different than the system LocaleID. (The system LocaleID is the default.)
Settings
The conversion argument settings are:
Constant Value Description
vbUpperCase 1 Converts the string to uppercase characters.
vbLowerCase 2 Converts the string to lowercase characters.
vbProperCase 3 Converts the first letter of every word in string to uppercase.
AND THERE IS MORE ...
TO GSERGE
$ means nothing when applied to a function name as opposed to a variable name. VBA uses $ AND B as a suffix to denote similar functionality.
VB6 IS VBA the person who said maybe in VB6 but not in VBA. VB6 program host VBA as their programming language. VB6 on it's own are some app objects and the forms package only - no programming language. It's best to think of VB6 as a VBA host like Office.
If you want to proper case see this WORDBASIC Ver 6 code, (which word 2003 helpfully converted to vba).
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Sub MAIN()
Select Case WordBasic.Int(GetModifer)
Case 0
WordBasic.ChangeCase
Case 1
WordBasic.ChangeCase 4
Case 2
WordBasic.ChangeCase 2
Case 3
ProperCase
Case Else
WordBasic.ChangeCase
End Select
End Sub
Private Sub ProperCase()
Dim F
Dim z
Dim a$
Dim P
F = 1
WordBasic.ChangeCase 2
WordBasic.EditBookmark Name:="SerenityChangeCase", SortBy:=0, Add:=1
z = WordBasic.GetSelEndPos()
WordBasic.CharLeft 1
While WordBasic.GetSelEndPos() < z And Not WordBasic.AtEndOfDocument()
WordBasic.SelectCurWord
a$ = WordBasic.[Selection$]()
P = 0
If LCase(a$) = "a" Then
P = 1
ElseIf LCase(a$) = "an" Then
P = 1
ElseIf LCase(a$) = "as" Then
P = 1
ElseIf LCase(a$) = "at" Then
P = 1
ElseIf LCase(a$) = "be" Then
P = 1
ElseIf LCase(a$) = "by" Then
P = 1
ElseIf LCase(a$) = "in" Then
P = 1
ElseIf LCase(a$) = "is" Then
P = 1
ElseIf LCase(a$) = "of" Then
P = 1
ElseIf LCase(a$) = "on" Then
P = 1
ElseIf LCase(a$) = "or" Then
P = 1
ElseIf LCase(a$) = "to" Then
P = 1
ElseIf LCase(a$) = "and" Then
P = 1
ElseIf LCase(a$) = "are" Then
P = 1
ElseIf LCase(a$) = "for" Then
P = 1
ElseIf LCase(a$) = "the" Then
P = 1
ElseIf LCase(a$) = "from" Then
P = 1
ElseIf LCase(a$) = "what" Then
P = 1
ElseIf LCase(a$) = "with" Then
P = 1
End If
If P = 1 And F = 0 Then WordBasic.Insert LCase(a$)
WordBasic.WordRight 1
F = 0
Wend
WordBasic.WW7_EditGoTo Destination:="SerenityChangeCase"
WordBasic.EditBookmark Name:="SerenityChangeCase", SortBy:=0, Delete:=1
End Sub
Private Function GetModifer()
Dim a
Dim B
Dim c
Dim X
a = GetAsyncKeyState(16)
B = GetAsyncKeyState(17)
c = GetAsyncKeyState(18)
X = 0
If a < 0 Then X = X + 1
If B < 0 Then X = X + 2
If c < 0 Then X = X + 4
GetModifer = X
End Function
OK. Yeah txtFirstName is a good indicator of usage here.. So I'd use (sort of) Title Caps And I'd do it on the Validate event.. So
Private Sub txtFirstName_Validate(Cancel As Boolean)
Dim p As Integer ' i doubt we'll use more than 32K for a name....
Dim mName As String
p = 1
' first off lets trim any leading blanks.. assume NOTHING and make sure its all lower case..
mName = LCase(LTrim(txtFirstName))
Do While p > 0 And p <= Len(txtFirstName) ' start with the first non-blank
Mid(mName, p, 1) = UCase(Mid(mName, p, 1))
p = InStr(p, mName, " ")
If p > 0 And p < Len(mName) Then p = p + 1
Loop
Cancel = False
txtFirstName = mName
End Sub
Works every time, and capitalizes each word.. Didn't add any code to to do TRUE title caps but this is close, and short & easy...
Dim group11_0_count = 0
Dim group11_1_count = 0
Dim group11_2_count = 0
Dim m As Integer = 0
Dim n As Integer = 0
Dim increment2 As Integer
For m = 0 To machings2.Items.Count - 1
For n = 0 To 3
If machings2.Items(m).ToString.Chars(n) = "1" Then
increment2 = increment2 + 1
End If
Next
If (increment2 = 0) Then
group11_0_count = group11_0_count + 1
group11_1_0.Items.Add(machings2.Items(m))
End If
If (increment2 = 1) Then
group11_1_count = group1_1_count + 1
group11_1_1.Items.Add(machings2.Items(m))
End If
If (increment2 = 2) Then
group11_2_count = group1_2_count + 1
group11_1_2.Items.Add(machings2.Items(m))
End If
increment2 = 0
Next
If (group11_0_count > 0 AndAlso group11_1_count > 0) Then
Dim result = ""
Dim index As Integer = 0
Dim gg As Integer = 0
Dim hh As Integer = 0
Dim i As Integer = 0
For hh = 0 To group11_1_count - 1
For gg = 0 To group11_0_count - 1
result = ""
index = 0
For i = 0 To 3
If group11_1_0.Items(gg).ToString.Chars(i) <> group11_1_1.Items(hh).ToString.Chars(i) Then
result &= "-"
index = index + 1
Else
result &= group11_1_0.Items(gg).ToString.Chars(i)
End If
Next
If (index = 1) Then
machings3.Items.Add(result)
End If
Next
Next
End If
I am comparing the items of two combobox items like that
combobox1 items
0000
combobox items
0001
0010
the result will be like that in machings3 combobox
000-
00-0
Here the differnce between two items indicated by - sign
But i am getting InvalidArgument=Value of '2' is not valid for 'index'.
I Can't make sense out of your source and where the IndexOutOfRangeException occurs. But you know that you need 3 Items in a Combobox to access Item with Index 2?! Every collection starts with 0.