For loop with offset function

[blw2002]

How to I increment the x and y data sets by one?
-------------------


Sub main_ols()
Dim x, y, z,
Dim strMsg As String


For x = 2 To 500

x = RangeToArray(Sheet4.Range("B2:B51"))
y = RangeToArray(Sheet4.Range("C2:C51"))

z = regress_orthols(x, y)

strMsg = "1.slope" & vbTab & z(1) & vbNewLine
strMsg = strMsg & "2.intercept" & vbTab & z(2) & vbNewLine
strMsg = strMsg & "3.sigma_slope" & vbTab & z(3) & vbNewLine
strMsg = strMsg & "4.sigma_intercept" & vbTab & z(4) & vbNewLine

MsgBox strMsg, vbInformation, "Least-squares Orthogonal Regression Result"

Sheet4.Range("slope") = z(1)
Sheet4.Range("intercept") = z(2)

z = regress_ls(x, y)

strMsg = "1.slope" & vbTab & z(1) & vbNewLine
strMsg = strMsg & "2.intercept" & vbTab & z(2) & vbNewLine
strMsg = strMsg & "3.sigma_slope" & vbTab & z(3) & vbNewLine
strMsg = strMsg & "4.sigma_intercept" & vbTab & z(4) & vbNewLine

MsgBox strMsg, vbInformation, "Least-squares Regression Result"
Next
Set x = RangeToArray("B2:B51").Offset([1], [0]).Select

Set y = Range("y").Offset(1, 0).Select

z = regress_orthols(x, y)
Set z(1) = Sheet4.Range("slope").Offset(1, 0).Select
Set z(2) = Sheet4.Range("intercept").Offset(1, 0).Select
Sheet4.Range("slope") = z(1)
Sheet4.Range("intercept") = z(2)

 

[texasalynn]

not tested
does this work
z = regress_orthols(x+1, y+1)

 

[blw2002]

not tested
does this work
z = regress_orthols(x+1, y+1)

could you be more specific please

Sub main_ols()
Dim x, y, z, COP, CVX
Dim strMsg As String
Dim longRow As Long



For x = 2 To 500

x = RangeToArray(Sheet4.Range("B2:B51"))
y = RangeToArray(Sheet4.Range("C2:C51"))

z = regress_orthols(x, y)

strMsg = "1.slope" & vbTab & z(1) & vbNewLine
strMsg = strMsg & "2.intercept" & vbTab & z(2) & vbNewLine
strMsg = strMsg & "3.sigma_slope" & vbTab & z(3) & vbNewLine
strMsg = strMsg & "4.sigma_intercept" & vbTab & z(4) & vbNewLine

MsgBox strMsg, vbInformation, "Least-squares Orthogonal Regression Result"

Sheet4.Range("slope") = z(1)
Sheet4.Range("intercept") = z(2)

z = regress_ls(x, y)

strMsg = "1.slope" & vbTab & z(1) & vbNewLine
strMsg = strMsg & "2.intercept" & vbTab & z(2) & vbNewLine
strMsg = strMsg & "3.sigma_slope" & vbTab & z(3) & vbNewLine
strMsg = strMsg & "4.sigma_intercept" & vbTab & z(4) & vbNewLine

MsgBox strMsg, vbInformation, "Least-squares Regression Result"
Next
' Set x = RangeToArray("B2:B51").Offset([1], [0]).Select

' Set y = Range("y").Offset(1, 0).Select

Function z() regress_orthols(x + 1, y + 1)
Set z(1) = Sheet4.Range("slope").Offset(1, 0).Select
Set z(2) = Sheet4.Range("intercept").Offset(1, 0).Select
'Sheet4.Range("slope") = z(1)
' Sheet4.Range("intercept") = z(2)


End Sub

Function regress_orthols(x, y)
Dim stat
Dim n As Long, i As Long
Dim mean_x As Double, mean_y As Double
Dim sig_x As Double, sig_y As Double
Dim u, v
Dim sum_v2 As Double, sum_u2 As Double, sum_uv As Double
Dim part1 As Double, part2 As Double, r As Double
Dim b(1 To 2)

stat = regress_ls(x, y)
n = UBound(x) - LBound(x) + 1
mean_x = Application.WorksheetFunction.Average(x)
mean_y = Application.WorksheetFunction.Average
sig_x = Application.WorksheetFunction.StDev(x)
sig_y = Application.WorksheetFunction.StDev

u = x
v = y
For i = LBound(x) To UBound(x)
u(i) = x(i) - mean_x
Next
For i = LBound To UBound
v(i) = y(i) - mean_y
Next

sum_v2 = Application.WorksheetFunction.Sum(element_mul(v, v))
sum_u2 = Application.WorksheetFunction.Sum(element_mul(u, u))
sum_uv = Application.WorksheetFunction.Sum(element_mul(u, v))

part1 = sum_v2 - sum_u2
part2 = Sqr((sum_u2 - sum_v2) ^ 2# + 4# * sum_uv * sum_uv)

b(1) = (part1 + part2) / (2# * sum_uv)
b(2) = (part1 - part2) / (2# * sum_uv)
r = sum_uv / Sqr(sum_u2 * sum_v2)
If Sgn(b(1)) = Sgn(stat(1)) Then
stat(1) = b(1)
Else
stat(1) = b(2)
End If
stat(2) = mean_y - stat(1) * mean_x
stat(3) = stat(1) * Sqr((1# - r * r) / n) / r
stat(4) = Sqr(((sig_y - sig_x * stat(1)) ^ 2) / n + (1# - r) * stat(1) * _
(2# * sig_x * sig_y + (mean_x * stat(1) * (1# + r) / (r * r))))

regress_orthols = stat
End Function

Function ones
Dim i As Long
Dim temp()

ReDim temp(1 To n)

For i = 1 To n
temp(i) = 1
Next

ones = temp
End Function

Function size(x) As Long
size = UBound(x) - LBound(x) + 1
End Function

Function element_mul(x, y)
Dim i As Long
Dim v()

ReDim v(1 To size(x))
For i = LBound(x) To UBound(x)
v(i) = x(i) * y(i)
Next

element_mul = v
End Function