I am trying to run Rungenkutta differential problem in excel VBA
program is as follows
Sub Rungenkutta()
Dim Noofitrations As Integer
Dim n As Integer
Dim ii As Integer
Noofitrations = Cells(2, 10)
n = Cells(3, 10)
h = Cells(3, 4)
col = 8
x0 = Cells(col, 9)
y0 = Cells(col, 10)
For i = 1 To Noofitrations
Cells(7, 3) = x0
Cells(7, 4) = y0
xn = x0 + h
yn = y0 + Cells(18, 3)
ii i Mod n
If ii = 0 Then
col = col + 1
Cells(col, 9) = xn
Cells(col, 10) = yn
End If
x0 = xn
y0 = yn
Next
End Sub
but while running I am getting "VBA excel compile error : Expected Sub,Function, or property"
I am not understanding what shall i do to run the program
Your problem is with the Mod operator. VBA doesn't recognize the syntax you provided.
Here is some documentation for the Mod operator - http://msdn.microsoft.com/en-us/library/se0w9esz.aspx
Th Mod operator is a binary operator and requires one left and one right argument.
You need to change
ii i Mod n
to
ii = i Mod n
Here is the revised example you provided.
Sub Rungenkutta()
Dim Noofitrations As Integer
Dim n As Integer
Dim ii As Integer
Noofitrations = Cells(2, 10)
n = Cells(3, 10)
h = Cells(3, 4)
col = 8
x0 = Cells(col, 9)
y0 = Cells(col, 10)
For i = 1 To Noofitrations
Cells(7, 3) = x0
Cells(7, 4) = y0
xn = x0 + h
yn = y0 + Cells(18, 3)
ii = i Mod n
If ii = 0 Then
col = col + 1
Cells(col, 9) = xn
Cells(col, 10) = yn
End If
x0 = xn
y0 = yn
Next
End Sub
Related
I am trying to sort tableData array acording to Thickness tableData(i,5). I tried in excel there is no problem but when ı try in Solidworks ı couldn't sort it. I checked for loop iteration in excel and solidworks there are some difference. Here is my code;
Dim temp0 As Double, temp1 As String, temp2 As Double, temp3 As String, temp4 As Double, temp5 As Double
For i = 0 To UBound(tableData, 1) - 1
For j = i + 1 To UBound(tableData, 1)
If tableData(i, 5) < tableData(j, 5) Then ' kalınlık
temp0 = tableData(j, 0)
temp1 = tableData(j, 1)
temp2 = tableData(j, 2)
temp3 = tableData(j, 3)
temp4 = tableData(j, 4)
temp5 = tableData(j, 5)
tableData(j, 0) = tableData(i, 0)
tableData(j, 1) = tableData(i, 1)
tableData(j, 2) = tableData(i, 2)
tableData(j, 3) = tableData(i, 3)
tableData(j, 4) = tableData(i, 4)
tableData(j, 5) = tableData(i, 5)
tableData(i, 0) = temp0
tableData(i, 1) = temp1
tableData(i, 2) = temp2
tableData(i, 3) = temp3
tableData(i, 4) = temp4
tableData(i, 5) = temp5
End If
Next j
Next i
I do not work in SolidWorks... But try the known QuickSort function:
Extremely fast 2D array sorting:
'To be called as QuickSort2D arr, 3 to sort Ascending
'To be called as QuickSort2D arr, , , False to sort Descending
Private Sub QuickSort2D(SortArray, Col As Long, Optional l As Long = -1, Optional r As Long = -1, Optional bAscending As Boolean = True)
Dim i As Long, j As Long, x, Y, k As Long
If IsEmpty(SortArray) Then Exit Sub 'the array is empty
If InStr(TypeName(SortArray), "()") < 1 Then Exit Sub 'the array is not valid
If l = -1 Then l = LBound(SortArray, 1) 'to avoid an error when giving value to X
If r = -1 Then r = UBound(SortArray, 1) 'to avoid an error when giving value to X
If l >= r Then Exit Sub 'no sorting needed, anymore
i = l: j = r
x = SortArray((l + r) / 2, Col) 'VBA automatically rounds (L + r)/2
'Choose an element of (aproximately) the middle of sorting column
If bAscending Then
While (i <= j)
While (SortArray(i, Col) < x And i < r)
i = i + 1
Wend
While (x < SortArray(j, Col) And j > l)
j = j - 1
Wend
If (i <= j) Then
For k = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, k)
SortArray(i, k) = SortArray(j, k)
SortArray(j, k) = Y
Next k
i = i + 1: j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, Col) > x And i < r)
i = i + 1
Wend
While (x > SortArray(j, Col) And j > l)
j = j - 1
Wend
If (i <= j) Then
For k = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, k)
SortArray(i, k) = SortArray(j, k)
SortArray(j, k) = Y
Next k
i = i + 1: j = j - 1
End If
Wend
End If
If (l < j) Then Call QuickSort2D(SortArray, Col, l, j, bAscending)
If (i < r) Then Call QuickSort2D(SortArray, Col, i, r, bAscending)
End Sub
Try calling it (in Excel) according to the next testing Sub:
SubTestQuickSort2D()
Dim arr, arr1
arr = Range("D2:F7").Value2
arr1 = arr
Debug.Print arr1(3.4, 1): 'Stop
QuickSort2D arr, 1
End Sub
It is really extremely fast!
Build the array and call the function using only its first two parameters (he second is the column to sort on it) and the last one to sort Ascending or Descending.
Being standard VBA (arrays) it should work in SolidWorks, too, I think.
Please, send some feedback after testing it.
There is a moment where the program has t = 1 but my if statement wont find it.
what gives?
Most of the question is code to fully experiment with the issue
What i am trying to do with my if statement is to find when t = whole number integers example 1,2,3,4,5 then do stuff to return other results but i cant find the moments when t= 1 so im stuck
Dim neq As Double
neq = 2
Dim e As Double
e = Exp(1)
Dim t_int As Integer
t_int = 5
'''''COUNTERS
Dim i As Integer
Dim j As Integer
Dim colOf As Integer
'''''EQUATION CONTROL
Dim h(3) As Double
Dim n As Double
'''''EQUATION CONTROL
Dim u() As Double
Dim uStar() As Double
Dim uOld() As Double
Dim uEx As Double
'''''EQUATION CONTROL
Dim f() As Double
Dim fOld() As Double
'''''EQUATION CONTROL
Dim t As Double
Dim tOld As Double
Dim tNew As Double
'''''SIZING ARRAY
ReDim u(neq)
ReDim uOld(neq)
ReDim uStar(neq)
ReDim f(neq)
ReDim fOld(neq)
'''''INITAL VAULES
h(1) = 0.1
h(2) = 0.05
h(3) = 0.025
u(1) = 2
u(2) = 0
colOf = 12
For j = 1 To 1
Cells(1, 1 + colOf) = "h(" & j & ") = " & h(j)
Cells(2, 1 + colOf) = "t"
Cells(2, 2 + colOf) = "u(1)"
Cells(2, 3 + colOf) = "u(2)"
Cells(2, 4 + colOf) = "uEx"
For n = 1 To (t_int / h(j))
tOld = t
t = tOld + h(j)
For i = 1 To neq
uOld(i) = u(i)
Next i
For i = 1 To neq
fOld(i) = fDeriv(uOld, tOld, i)
uStar(i) = uOld(i) + h(j) * fOld(i)
Next i
For i = 1 To neq
f(i) = fDeriv(uStar, t, i)
u(i) = uOld(i) + (h(j) * (fOld(i) + f(i))) / 2
Next i
i = i - 1
uEx = 2 * e ^ -t * (Cos((3 ^ 0.5) * t) + ((3 ^ 0.5) ^ -1) * Sin((3 ^ 0.5) * t))
Cells(n + 2, 1 + colOf) = t
Cells(n + 2, 2 + colOf) = u(1)
Cells(n + 2, 3 + colOf) = u(2)
Cells(n + 2, 4 + colOf) = uEx
**If t = 1 Then Debug.Print t**
Next n
colOf = colOf + 5
Next j
I have been working on this code for a while. As you can see after the code line " With ws(2)" there is an if condition. Now, I have multiple to create multiple such If conditions such as for 0.6, 0.7, 0.8 etc. (and each such condition should use a different table of data) {I am posting the excel file link for the tables as well so that you can get an idea} Can I do this using a function or any method which wont require me to write this code again and again for each new condition ?
https://docs.google.com/file/d/0B1DVNSutDHR0QWd2UUJsVDZ1Tm8/edit
Private Sub CommandButton1_Click()
Dim x(1 To 9000) As Double, y(1 To 9000) As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double, I1(1 To 9000) As Double, I2(1 To 9000) As Double, R1(1 To 9000) As Double, R2(1 To 9000) As Double, a As Double, b As Double, c As Double, d As Double, Result(1 To 9000) As Double
Dim i As Integer, j As Integer, k As Integer, p As Integer, q As Integer, r As Integer, s As Integer, t As Integer
Dim ws As Sheets
Set ws = ActiveWorkbook.Sheets(Array("Sheet1", "PLP-1", "PLP-2"))
For t = 0 To 120 Step 20
For k = 1 To 9000
With ws(1)
I1(k) = .Cells(k + 2, 13).Value
I2(k) = .Cells(k + 2, 14).Value
End With
With ws(2)
Select Case .Cells(6 + t, 1).Value
Case 0.5:
r = 0
s = 0
Case 0.6:
r = 20
s = 1
Case 0.7:
r = 40
s = 2
Case 0.8:
r = 60
s = 2
Case 0.9:
r = 80
s = 3
Case 1:
r = 100
s = 4
Case 1.1:
r = 120
s = 5
End Select
For i = 7 To 22
If (.Cells(i + r, 1).Value <= I1(k)) And (I1(k) <= .Cells(i + r + 1, 1).Value) And Not (IsEmpty(I1(k))) Then
p = i + r
x(k) = I1(k)
x1 = .Cells(i + r, 1).Value
x2 = .Cells(i + r + 1, 1).Value
End If
Next i
For j = 2 To 8
If (.Cells(6 + r, j).Value <= I2(k)) And (I2(k) <= .Cells(6 + r, j + 1).Value) And Not (IsEmpty(I2(k))) Then
q = j + r
y(k) = I2(k)
y1 = .Cells(6 + r, j).Value
y2 = .Cells(6 + r, j + 1).Value
End If
Next j
If p <> 0 And q <> 0 Then
a = .Cells(p, q).Value
b = .Cells(p, q + 1).Value
c = .Cells(p + 1, q).Value
d = .Cells(p + 1, q + 1).Value
End If
If I1(k) = Empty Then
R1(k) = 0
Else
R1(k) = (((y2 - y(k)) / (y2 - y1)) * a) + (((y(k) - y1) / (y2 - y1)) * b)
End If
If I2(k) = Empty Then
R2(k) = 0
Else
R2(k) = (((y2 - y(k)) / (y2 - y1)) * c) + (((y(k) - y1) / (y2 - y1)) * d)
End If
Result(k) = (((x2 - x(k)) / (x2 - x1)) * R1(k)) + (((x(k) - x1) / (x2 - x1)) * R2(k))
End With
With ws(1)
.Cells(k + 2, 15 + s).Value = Result(k)
End With
Next k
Next t
End Sub
Try using a Select Case statement as below:
Dim iStart As Long, iEnd As long, jStart As Long, jEnd As Long
'...
With ws(2)
Select Case .Cells(6, 1).Value
Case 0.5:
iStart = 7: iEnd = 22
jStart = 2: jEnd = 7
Case 0.6:
'Same as above but substitute new values for iStart etc.
End Select
For i = iStart To iEnd
'DO STUFF WITH i
Next i
For j = jStart To jEnd
'DO STUFF WITH j
Next j
End With
EDIT: Updated to reflect needs clarified in comments
A more in-depth explanation and usage guide for Select Case can be found here
With regard to your looping, if I understand your code, you need to loop through each "table", but your I and J refer to absolute addresses. What you want is to have I and J be relative to the desired table.
I just used values of 2 to 7, but if the tables are different sizes, you could certainly determine that with code; or even read them into a variant array and do your testing on the array (would often be faster).
So something like the following (pseudo code)
Option Explicit
'N is the Value that defines the proper table
Function DoYourThingOnProperRange(N As Double)
Dim C As Range
Dim I As Long, J As Long
With Sheet1.Columns(1)
Set C = .Find(what:=N, after:=Sheet1.Cells(Rows.Count, "A"), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
If Not C Is Nothing Then
Set C = C.CurrentRegion 'C is now set to the proper table
'DoYourThing
'Here's just a dummy routine
For I = 2 To 7
For J = 2 To 7
Debug.Print C(I, J).Address
Next J
Next I
Else
'some kind or error routine for non-existent table
End If
End With
End Function
I am trying to write a general code for matrix multiplication but when I am trying to verify it, the output is always a null matrix. So it seems that the values of the temp matrix are not getting updated.
Please suggest some changes for it to work. The code is copied below:
Public Function matrixmultiply(x() As Double, y() As Double) As Double()
Dim nrow1 As Integer, nrow2 As Integer, ncol1 As Integer, ncol2 As Integer, i As Integer, j As Integer, k As Integer, temp() As Double
nrow1 = UBound(x, 1) - LBound(x, 1) + 1
ncol1 = UBound(x, 2) - LBound(x, 2) + 1
nrow2 = UBound(y, 1) - LBound(y, 1) + 1
ncol2 = UBound(y, 2) - LBound(y, 2) + 1
ReDim matrixmultiply(1 To nrow1, 1 To ncol2)
ReDim temp(1 To nrow1, 1 To ncol2)
For i = 1 To nrow1
For j = 1 To ncol2
d = 2
For k = 1 To col1
temp(i, j) = temp(i, j) + x(i, k) * y(k, j)
Next k
Next j
Next i
matrixmultiply = temp
End Function
Private Sub CommandButton1_Click()
Dim x(1 To 3, 1 To 3) As Double, y(1 To 3, 1 To 3) As Double, z() As Double
Dim i As Integer, j As Integer
For i = 1 To 3
For j = 1 To 3
x(i, j) = Cells(i, j).Value
y(i, j) = Cells(i, j + 5).Value
Next j
Next i
z = matrixmultiply(x, y)
For i = 1 To 3
For j = 1 To 3
Cells(i, j + 12).Value = z(i, j)
Next j
Next i
End Sub
Silly mistake in the line:
For k = 1 To col1
It should, instead, be
For k = 1 To ncol1
Using Option Explicit would have saved a lot of hurt!
I am trying to sum up all of the random integer values over 500 and then present them in a text box, however it is not working and whenever I run the code, it sums to zero. This is inside of a user form using VBA. Any suggestions would be appreciated.
Private Sub CommandButton1_Click()
Dim r As Double, c As Double, rand As Double, y As Double, x As Double, i As Double
r = TextBox1.Value
c = TextBox2.Value
rand = TextBox3.Value
Rnd [5]
i = 0
For x = 1 To r
For y = 1 To c
Cells(x, y).Value = Int(Rnd * rand)
If (ActiveCell.Value >= 500) Then
i = i + ActiveCell.Value
Else ' do nothing
End If
Next y
Next x
Cells(r + 1, c).Value = "SUM"
Cells(r + 1, c + 1).Value = i
MsgBox (i)
End Sub
I don't know much about VBA, but could
Cells(x, y).Value = Int(Rnd * rand)
If (ActiveCell.Value >= 500) Then
.. be referring to different cells?