Help With my program

A

akissinger

Here is some code i wrote to do stats on the data at the bottom. I
was wondering if anyone could tell me why the program will only alow
for 221 data points to be accurate. At 222 the algorithm does not
give the correct answer. In put the data into The input column J.
The data is sorted so that all the negs are on the bottem with and
then the algorithm is then run to give a regression of the data and is
output on the 3 or 4th row from the bottom. HELP

Sub Counting()


'Counting Macro
'Macro recorded 7/23/2007 by Andrew Kissinger
Dim g As Long
Dim x As Long
Dim z As Long
Dim t As Long
Dim temp As Long
Dim LastRow As Long
Dim B As Double
Dim Inter As Double
Dim Alpha As Double
Dim NumOfNeg As Long
'Dim Trim As Long
Dim e As Long
Dim ti As Long
Dim tx(1 To 1000, 1 To 1000) As Long
Dim numer As Double
Dim denom As Double
Dim beta As Double


Range("$A$2:I$" & temp + 10).ClearContents


LastRow = Cells(Application.Rows.Count, 10).End(xlUp).Row ' quack


x = 2
Do While Cells(x, 10).Value <> "" '|input the rank column
x = x + 1 '|
Loop '|
temp = x - 2


'MsgBox ("temp: " & temp) '| used to debug the number of items


Dim i As Long '| this loop is to trim the data
from online


For g = 2 To temp + 1
Cells(g, 2).Value = Left(Trim(Cells(g, 10).Value),
Len(Trim(Cells(g, 10).Value) - 1))
Cells(g, 9).Value = Abs(Left(Trim(Cells(g, 10).Value),
Len(Trim(Cells(g, 10).Value) - 1)))
'Cells(g, 7).Value = Right(Trim(Cells(g, 7).Value),
Len(Trim(Cells(g, 7).Value) - 1))
Next g


'For Trim = 2 To temp
' Cells(Trim, 7).Value = Left(Trim(Cells(Trim, 7).Value),
Len(Trim(Cells(Trim, 7).Value) - 1))
'Next Trim


Sort (LastRow) '| this sort is to sort the data in column A
NumOfNeg = CountNEG(temp)
For num = 2 To temp + 1
Cells(num, 1).Value = num - 1
Next num


Call SensorPoints2(temp, NumOfNeg)
i = 2
'MsgBox ("numofneg: " & NumofNeg)


Cells(1, 4).Value = 0


For ti = 2 To temp + 1
Cells(ti, 4).Value = Cells(ti - 1, 4).Value + ((temp + 1 - Cells(ti
- 1, 4).Value) / (temp + 2 - Cells(ti, 1).Value))
Next ti
'MsgBox ("here is temp: " & temp)


Do While Cells(i, 2).Value > 0


' Cells(i, 4).Value = 1 / (1 - Cells(i, 4).Value)
Cells(i, 3).Value = Log(Cells(i, 2).Value)
Cells(i, 5).Value = Log(-1 * Log(1 - ((Cells(i, 4).Value) - 0.3) /
(temp + 0.4)))
Cells(i, 6).Value = (Cells(i, 3).Value) ^ 2
Cells(i, 7).Value = (Cells(i, 5).Value) ^ 2
Cells(i, 8).Value = Cells(i, 3).Value * Cells(i, 5).Value


i = i + 1
' MsgBox (" this is cell 4930: " & Log(Cells(i, 1).Value))
Loop


'Call RunREG(temp, NumOfNeg)


Cells(temp + 3, 3).Value = 0
Cells(temp + 3, 5).Value = 0
Cells(temp + 3, 6).Value = 0
Cells(temp + 3, 7).Value = 0
Cells(temp + 3, 8).Value = 0


For B = 2 To temp + 1
Cells(temp + 4, 3).Value = Cells(temp + 4, 3).Value + Cells(B,
3).Value
Cells(temp + 4, 5).Value = Cells(temp + 4, 5).Value + Cells(B,
5).Value
Cells(temp + 4, 6).Value = Cells(temp + 4, 6).Value + Cells(B,
6).Value
Cells(temp + 4, 7).Value = Cells(temp + 4, 7).Value + Cells(B,
7).Value
Cells(temp + 4, 8).Value = Cells(temp + 4, 8).Value + Cells(B,
8).Value
Next B


Cells(1, 3).Value = "Ln(Ti)"
Cells(1, 4).Value = "F(Ti)"
Cells(1, 5).Value = "yi"
Cells(1, 6).Value = "(Ln(Ti)^2)"
Cells(1, 7).Value = "(yi^2)"
Cells(1, 8).Value = "Ln(Ti)*yi"


Cells(temp + 6, 1).Value = "Bata (Shape perameter)= "
Cells(temp + 7, 1).Value = "Alpha (Characteristic Life)= "
Dim lnti As Double
Dim fti As Double
Dim yi As Double
Dim lnTisqr As Double
Dim yisqr As Double
Dim lntiyi As Double


lnti = Cells(temp + 4, 3).Value
yi = Cells(temp + 4, 5).Value
lnTisqr = Cells(temp + 4, 6).Value
yisqr = Cells(temp + 4, 7).Value
lntiyi = Cells(temp + 4, 8).Value


numer = lntiyi - lnti * (yi / (temp - NumOfNeg))
denom = lnTisqr - ((lnti ^ 2) / (temp - NumOfNeg))
'MsgBox ("What is this cell: " & Cells(temp + 4, 3).Value)
'MsgBox ("What is this cell: " & Cells(temp + 4, 5).Value)
'MsgBox ("What is this cell: " & Cells(temp + 4, 6).Value)
'MsgBox ("What is this cell:numer " & numer)
'MsgBox ("What is this cell:denom " & denom)


beta = numer / denom
Cells(temp + 6, 3).Value = beta
'Inter = Cells(temp + 21, 2).Value
'MsgBox ("What is this cell: " & Inter & " " & B)


'Cells(temp + 24, 3).Value = Alpha
Alpha = (yi / (temp - NumOfNeg)) - (beta * (lnti / (temp -
NumOfNeg)))
Cells(temp + 7, 3).Value = Exp((-1 * Alpha) / beta)


End Sub


'| This is the sub function that is used to sort the data
'| the code for this was taken by the macro recorder
Sub Sort(temp)


Dim i As Long
Dim tempcellV As Long
Dim tempcellv1 As Long
Dim j As Long
Dim h As Long
Dim tempcell(1 To 1000, 1 To 1000) As Double
Dim g As Long
Dim k As Long
Dim t As Long
Dim m As Long
Dim testcell As Long


k = temp + 1


Sheet1.Activate
Sheet1.Range("A2:I1000").Select


Selection.Sort Key1:=Range("I2"), Key2:=Range("B2"),
Order1:=xlAscending, Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortTextAsNumbers


End Sub


Function RunREG(temp As Long, NumOfNeg As Long)
'| this is to run the regression tool pack for the data


Debug.Print "Range A Address: " & ActiveSheet.Range("$E$2:$E$" & temp
- NumOfNeg + 1).Address
Debug.Print "Range A Address: " & ActiveSheet.Range("$f$2:$f$" & temp
- NumOfNeg + 1).Address
Application.Run "'atpvbaen.xla'!Regress", ActiveSheet.Range("$e$2:$e
$"
& temp - NumOfNeg + 1), _
ActiveSheet.Range("$f$2:$f$" & temp - NumOfNeg + 1), False,
False, , ActiveSheet.Range( _
"$A$" & temp + 4 & ":$H$" & temp + 20), False, False, False,
False, , False


End Function
S


'| for counting the negitives to know what numbers to calc.


Function CountNEG(temp As Long) As Long
Dim i As Long
Dim x As Long
x = 0


For i = 2 To temp
If Cells(i, 2).Value < 0 Then
x = x + 1
End If
Next i
CountNEG = x
End Function
Sub Font()
'
' Macro5 Macro
' Macro recorded 8/6/2007 by Rex Little
'


'
Columns("A:I").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub


Sub SensorPoints2(temp As Long, NumOfNeg As Long)


'| This will move the sensor points to the bottom of the data
'| after they have been ranked
Dim bLoop As Boolean
bLoop = False
Dim i As Long
Dim j As Long
Dim h As Long
Dim tempcell(1 To 1000, 1 To 1000) As Double
Dim tempcol(1 To 1000, 1 To 1000) As Double
Dim temp2 As Long


temp2 = temp
'MsgBox ("Temp2: " & temp2)


For i = 2 To temp


If Cells(i, 2).Value < 0 And i <= temp - NumOfNeg Then
bLoop = True
'if Cells(i, 1).Value < 0
For j = i To temp2
For h = 1 To 8
tempcol(j, h) = Cells(j, h).Value
Cells(j, h).Value = Cells(j + 1, h).Value
Cells(j + 1, h).Value = tempcol(j, h)
Next h
Next j
'Loop
End If


'MsgBox (" this is the next i: " & i)


Next i
If bLoop = True Then
Call SensorPoints2(temp, NumOfNeg)
Else
Call Font
End If
End Sub


*****************************************************
5411
4715
9964
12964
5538
8754
8415
9875
10512
6665
3023
9032
9486
21115
7929
10234
3018
3275
11069
11094
12827
1625
4985
7118
14943
9497
12323
5822
2792
3893
7719
6018
14291
1413
12060
7214
5434
1943
6155
5918
13161
6079
10318
9990
5072
7939
4570
13276
2069
7495
8411
8409
8953
10015
4986
3410
12121
8707
9926
5491
12481
6998
4777
8406
8793
8980
11405
1669
5424
13015
4759
12460
7468
4666
4970
7271
12724
12266
15402
12636
6483
42
5943
3939
3330
9150
-4429
-3277
-4382
-1184
-2665
-4865
-6455
-5114
-4088
-1390
-4590
-4723
-2749
-1996
-3537
-2875
-2105
-1843
-1978
-1183
-1113
-2598
-230
-1429
-3589
-90
-3469
-3634
-1570
-1496
-618
-1324
-3910
-227
-6219
-5770
-912
-3659
-1094
-3125
-4618
-2398
-2899
-2662
-657
-3525
-2762
-1213
-3199
-4939
-2625
-3623
-1287
-4170
-2708
-3717
-2685
-6362
-3053
-4690
-7143
-2519
-1430
-6151
-2761
-3014
-337
-1227
-2473
-4837
-2079
-3192
-1229
-3101
-1311
-3343
-1907
-6755
-5512
-6563
-974
-2311
-3604
-605
-4798
-4350
-2712
-1892
-3876
-4344
-2406
-4747
-7834
-23
-2892
-3753
-454
-6295
-8157
-3569
-3255
-1941
-551
-1227
-664
-4369
-1011
-3232
-2210
-4328
-2153
-3672
-184
-2730
-2789
-2991
-2032
-2003.4
-5284.8
-13474.8
-14965.2
-12142.8
-6310.8
-11815.2
-7956
-4521.6
-10436.4
-10629
-5214.6
-4638.6
-6188.4
-7495.2
-7068.6
-7135.2
-11341.8
-16683.88
 
J

Joel

You are only reading 221 number becasue you start your indexes at 2.

x = 2 <============ starts at 2
Do While Cells(x, 10).Value <> "" '|input the rank column
x = x + 1 '|
Loop '|
temp = x - 2


'MsgBox ("temp: " & temp) '| used to debug the number of items

Dim i As Long '| this loop is to trim the data
'from online
For g = 2 To temp + 1 <============ starts at 2
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top