16
Hi,
I have the code below that I adapted to loop through each column of data (Columns A to GR) to perform an a calculation based on the data in rows 2 to 31 of each column and place the calculated statistic in row 35 for each column of data.
The problem is the code runs fine for the first six columns of data (i.e row 35 for columns A:F get populated with a correctly calculated statistic but code stops running at column G, and generates a Overflow, Runtime error 6). Debugging takes you to the following line in the code: RS = R / S
Does anyone know what could be causing this. I read that dimming variables as long as opposed to integer can fix this problem but I tried this but I still get the same error.
Could this be a memory issue for Excel?
Note I am not a VBA programming.
I hope someone can help.
Thanks,
Lucas
-----------------------------------------------------
Option Base 1
Sub Newcode() 'code works within worksheet
Dim Data() As Double
Dim Array1() As Double
Dim Array2() As Double
Dim Mean As Double
Dim Result1() As Double
Dim Resultn() As Double
Dim Resultr() As Double
Dim Resultn1() As Double
Dim Resultr1() As Double
Dim maxa() As Integer
Dim points As Integer
Dim pointno As Integer
Dim no_N As Integer
Dim period As Integer
Dim N, pe As Integer
Dim i, j, counter As Integer
Dim m, sc, c, ss, cc As Integer
Dim logten
Dim R, Maxi, Mini, h As Double
Dim S, sum_R, sum_S, Summ As Double
Dim RS, wid, wid1, Sumx, Sumy, Sumxx, Sumxy As Double
Dim nam, nama1, addr, mvar, Msg, nama, os As Variant
logten = Log(10)
'START OF NEW CODE
Dim a, x, y As Integer 'new /new bits to loop through columns
x = Cells(2, Columns.Count).End(xlToLeft).Column 'new/start at row 2, determines no of columns to calculate
For a = 1 To x 'new
y = 31 'specify number of rows else it doesn't work if you let it self select, ensure there is no data below
'y = Cells(Rows.Count, a).End(xlUp).Row 'new
b = Chr(a + 64) 'new
c = b & "2:" & b & y 'starts at row 2
'Get and output total number of data points
Set inputdata = Range(c)
'END OF NEW CODE
'Get total number of data points
points = inputdata.Cells.Rows.Count
pe = 5
If pe < 3 Then
MsgBox "Cannot have less than three periods"
End
End If
ReDim Data(points) As Double
'Get data, ignoring any spaces
i = 1
counter = 1
Do While counter <= points 'no of data points
If Application.WorksheetFunction.IsNumber(inputdata.C ells(counter).Value) Then
Data(counter) = inputdata.Cells(counter).Value
counter = counter + 1
Else
addr = inputdata.Cells(counter).Address
End If
i = i + 1
Loop
ReDim Result1(points) As Double
ReDim Resultn(points) As Double
ReDim Resultr(points) As Double
ReDim Resultn1(points - (pe - 1)) As Double
ReDim Resultr1(points - (pe - 1)) As Double
'Begin main loop
N = pe '3
Do
For period = 1 To points 'no_N
DoEvents
ReDim Array1(N) As Double
ReDim Array2(N) As Double
For i = 1 To N
Array1(i) = Data(i)
Array2(i) = 0
Next i
Mean = Application.Average(Array1())
'STDEVP
S = Application.StDevP(Array1())
For i = 1 To N
Array1(i) = Array1(i) - Mean
Next i
Array2(1) = Array1(1)
For i = 2 To N
Array2(i) = Array2(i - 1) + Array1(i)
Next i
Maxi = Application.Max(Array2())
Mini = Application.Min(Array2())
R = Maxi - Mini
RS = R / S
Resultr(period) = Application.Ln(RS)
Resultn(period) = Application.Ln(N)
Result1(period) = RS / Sqr(N)
N = N + 1
Application.StatusBar = " Running period " & N - 1
wid = ((N / points) * 100) * 2.22
wid1 = (N / points) * 100
If N > points Then Exit For
Next period
Loop Until N > points ' + 2
'Calculate statistic
For i = 1 To points - (pe - 1) '2
Resultr1(i) = Resultr(i)
Resultn1(i) = Resultn(i)
Next i
h = Application.Slope(Resultr1(), Resultn1())
Range(b & "35").Value = h 'NEW - change to reflect where result should be shown
Next a 'NEW
End Sub
