I wrote this code and the result is shown in the blue column.
`
Sub ematest()
'Calculate alpha for each periods
Dim alphas As Integer 'smoothing factor short moving average
Dim alphal As Integer 'smoothing factor long moving average
alphas = 2 / (Cells(3, 13).Value + 1)
alphal = 2 / (Cells(3, 14).Value + 1)
'Calculate 50 days Exponential MA
'calculate sema
For m = 53 To 6102
Cells(m, 13) = (Cells(m, 5) * alphas) + ((1 - alphas) * Cells(m, 9)) 'for Column M
Next m
'calculate lema
For n = 203 To 6102
Cells(n, 14) = (Cells(n, 5) * alphal) + ((1 - alphal) * Cells(n, 10)) 'for Column N
Next n
End Sub
`
I expect the result as shown in the yellow column where it is calculated by excel function for checking.
Am I missing something or have I make mistake?
The data type being used is 'truncating' the results of your calculation.
Try using a data type of Double instead of Integer.
Run this code example to see the differences caused by the data type.
Sub ematestint()
Dim alphas As Integer
Dim alphal As Integer
alphas = (Worksheets("Sheet1").Cells(3, 13).Value)
alpha1 = (Worksheets("Sheet1").Cells(3, 14).Value)
alphas = alphas + 1
alpha1 = alpha1 + 1
alphas = 2 / alphas
alpha1 = 2 / alpha1
MsgBox "alphas = " & alphas & vbCrLf & "alpha1 =" & alpha1
End Sub
Sub ematestdbl()
Dim alphas As Double
Dim alpha1 As Double
alphas = (Worksheets("Sheet1").Cells(3, 13).Value)
alpha1 = (Worksheets("Sheet1").Cells(3, 14).Value)
alphas = alphas + 1
alpha1 = alpha1 + 1
alphas = 2 / alphas
alpha1 = 2 / alpha1
MsgBox "alphas = " & alphas & vbCrLf & "alpha1 =" & alpha1
End Sub
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 can't work out why a simple vba code won't increment a variable. Any help would be greatly appreciated
Sub regression_coeff()
Dim x1 As Integer, x2 As Integer, i As Integer
Dim inc As Integer
inc = 1
x1 = 1
x2 = 1
For i = 0 To 10
x2 = x2 + 1
Next i
End
'x1 = x1 / x
'x2 = x2 / x
Cells(1, 3).Value = x1
'Cells(1, 4).Value = x2
End Sub
I thought it might be due to the variable definition but it didn't help
Cheers
D
Option Explicit
Sub regression_coeff()
Dim x1 As Integer, x2 As Integer, i As Integer
Dim inc As Integer
inc = 1
x1 = 1
x2 = 1
For i = 0 To 10
x2 = x2 + 1
Next i
'x1 = x1 / x
'x2 = x2 / x
Cells(1, 3).Value = x1
Cells(1, 4).Value = x2
End Sub
It works by me like this. The problem with your code was the End, which stops it. Here is a bit more about END.
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 new to VBA and I wanted to write down a simple piece of code for implementing a double summation of binomial distribution product. The code I have written is:
Sub reactiveTransshipment()
Dim i As Integer
i = 0
Dim j As Integer
j = 0
Dim y1 As Integer
y1 = 1037
Dim y2 As Integer
y2 = 1037
Dim PI1 As Double
PI1 = 0
Dim PI1_1 As Double
PI1_1 = 0
Dim PI1_2 As Double
PI1_2 = 0
Dim k1 As Double
Dim k2 As Double
Dim n As Integer
n = 2000
Dim P As Double
P = 0.5
For j = 0 To (y2 - 1)
For i = (y1 + 1) To (y1 + y2 - j)
k1 = WorksheetFunction.BinomDist(i, n, P, False)
k2 = WorksheetFunction.BinomDist(j, n, P, False)
PI1_2 = PI1_2 + (k1 * k2)
Next i
Next j
Worksheets(2).Range("D2").Value = k1
End Sub