# Comparing values in an Array

This is a discussion on Comparing values in an Array within the Excel Questions forums, part of the Question Forums category; Hi I went to this web site to get non-linear regression code: http://digilander.libero.it/foxes/optimiz/Optimiz1.htm (I STINK at math) I brought down ...

1. ## Comparing values in an Array

Hi

I went to this web site to get non-linear regression code:
http://digilander.libero.it/foxes/optimiz/Optimiz1.htm

(I STINK at math)

I brought down all the modules and they work.

The end result of their 1st example per them should be:

Non-linear regression of: exp(c1*x) + c2
c1 = -0.499999999999998
c2 = 0.999999999999997

which is what I get:

Here is their caller routine:

Code:
```Sub NLfit_test1()

Dim tmp, x() As Double, y() As Double, c() As Double
Dim n As Long, i As Long, ch2 As Double
Dim iter As Long, itermax As Long

tmp = Array(1.7788007830714, 1.60653065971263, 1.47236655274101, _
1.36787944117144, 1.28650479686019, 1.22313016014843, _
1.17377394345045, 1.13533528323661, 1.10539922456186, 1.0820849986239)

n = UBound(tmp) + 1
ReDim x(1 To n), y(1 To n)
For i = 1 To n
y(i) = tmp(i - 1)
Next i

tmp = Array(0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5)
For i = 1 To n
x(i) = tmp(i - 1)
Next i

ReDim c(1 To 2)
'initialize with a starting point (c1, c2) that you like
c(1) = 0: c(2) = 0

'find the best fit for f(x, c1, c2) = exp(c1*x) + c2
Deriv_Approx = False
iter = 0: itermax = 100
Call LMNoLinearFit(x, y, c, ch2, iter, itermax)

'check convegergence
If iter >= itermax Then
Debug.Print "convergence failed. iter ="; iter
Exit Sub
End If

'Output results
Debug.Print "Non-linear regression of:  exp(c1*x) + c2"
For i = 1 To UBound(c)
Debug.Print "c" & i & " = "; c(i)
Next i

End Sub```
Because I don't want to manually type in data for this
part of the code

Code:
```'load y data
tmp = Array(1.7788007830714, 1.60653065971263, 1.47236655274101, _
1.36787944117144, 1.28650479686019, 1.22313016014843, _
1.17377394345045, 1.13533528323661, 1.10539922456186, 1.0820849986239)```
I pasted the data to Column B of a WS and
and tried to create the data from the WS.

The gist of my code is:

Code:
```dim MyTmp as variant

MyTmp = Array(1.7788007830714, 1.60653065971263, 1.47236655274101, _
1.36787944117144, 1.28650479686019, 1.22313016014843, _
1.17377394345045, 1.13533528323661, 1.10539922456186, 1.0820849986239)

'----------------
'   Row Cnt In Range
'----------------
Row_CNT = Rng_Y_Values.Rows.Count

'----------------
'   Redim Array
'----------------
ReDim dbl_Y_Array(0 To Row_CNT - 1)

'----------------
'----------------
For lng = 1 To Row_CNT
dbl_Y_Array(lng - 1) = Rng_Y_Values.Cells(lng)
Next

'----------------
'   Compare Values
'----------------
For lng = 0 To Row_CNT - 1
If MyTmp(lng) <> dbl_Y_Array(lng) Then
FYI = MyTmp(lng) & vbCrLf & vbCrLf
FYI = FYI & dbl_Y_Array(lng)
MsgBox FYI
End If
Next

'----------------
'----------------
tmp = dbl_Y_Array```
Here are my points:

In the MSGBOX routine - which perhaps I am not coding
correctly - it is telling me the values are not equal.

But the numbers appearing from the msgbox are the same.

Using this approach I get a different answer than

Is there something UNIQUE about a double value being stored
to a variant VERSUS a double value being stored to an array
declared as double

Dim dbl_Y_Array() As Double
Dim MyTmp As Variant

'Their declaration and what is passed into other functions
Dim tmp

Confused.

Should anyone respond to this I will be gone for about 2 hours.
before I can respond back.

regards
John

2. ## Re: Comparing values in an Array

The original code is dimensioning tmp as a variant because it will be initialized using the Array function which returns a variant. There should be no problem dimensioning your array as double. Have you looked at the actual values being compared on this line: "If MyTmp(lng) <> dbl_Y_Array(lng) Then"? It may be preferable to phrase your If-Then statement in terms of the absolute value of the difference being greater then some insignificant amount:
If Abs(MyTmp(lng) - dbl_Y_Array(lng)) > 1e-6 Then ...

3. ## Re: Comparing values in an Array

I copy/pasted the values, one at a time into B1:B10, then ran this version of your code:
Code:
```Sub test1()
Dim MyTmp As Variant
Dim dbl_Y_Array() As Double
MyTmp = Array(1.7788007830714, 1.60653065971263, 1.47236655274101, _
1.36787944117144, 1.28650479686019, 1.22313016014843, _
1.17377394345045, 1.13533528323661, 1.10539922456186, 1.0820849986239)

'----------------
'   Row Cnt In Range
'----------------
Set Rng_Y_Values = Range("B1:B10")
Row_CNT = Rng_Y_Values.Rows.Count

'----------------
'   Redim Array
'----------------
ReDim dbl_Y_Array(0 To Row_CNT - 1)

'----------------
'----------------
For lng = 1 To Row_CNT
dbl_Y_Array(lng - 1) = Rng_Y_Values.Cells(lng)
Next

'----------------
'   Compare Values
'----------------
For lng = 0 To Row_CNT - 1
If MyTmp(lng) <> dbl_Y_Array(lng) Then
FYI = MyTmp(lng) & vbCrLf & vbCrLf
FYI = FYI & dbl_Y_Array(lng)
MsgBox FYI
'        MsgBox MyTmp(lng) - dbl_Y_Array(lng)
End If
Next
End Sub```
No message boxes popped up. I'm using excel 2010 - and your version is?
There's a commented out line above which will show the difference between the two values; what order of differences do you have?
You coulkd also explore the following method of getting data into an array:
Code:
```Sub blah()
tmp = Array(1.7788007830714, 1.60653065971263, 1.47236655274101, _
1.36787944117144, 1.28650479686019, 1.22313016014843, _
1.17377394345045, 1.13533528323661, 1.10539922456186, 1.0820849986239)
tmp2 = Application.Transpose(Range("B1:B10").Value)
For i = 1 To 10
If tmp(i - 1) <> tmp2(i) Then MsgBox tmp(i - 1) & vbLf & tmp2(i)
Next i
End Sub```
Again, no message boxes.

4. ## Re: Comparing values in an Array

Hi JoeMo

If Abs(MyTmp(lng) - dbl_Y_Array(lng)) > 0.0000000001 Then

worked in that the MSGBOX did not fire off.

My ERROR in terms of result was due to BAD CODE downstream of the MsgBox.
Everything now works.

Thank you.

regards
John

5. ## Re: Comparing values in an Array

Hi p45cal

(a) I am using Excel 2007

(b) I can STILL reproduce the MSGBOX coming up. This code will do it.
(You will have to comment out some of the top code)

Code:
```Sub NLfit_Test1()
'Search On: vba nonlinear regression
On Error GoTo EH_NLfit_Test1

'-----------------
'-----------------
Dim lng As Long
Dim FYI As String
Dim n1 As Long

'-----------------
'-----------------
Dim dbl_Y_Array() As Double
Dim dbl_X_Array() As Double

'-----------------
'   Original Vars
'-----------------
Dim x() As Double
Dim y() As Double
Dim c() As Double

Dim n As Long
Dim i As Long
Dim ch2 As Double
Dim iter As Long
Dim itermax As Long

'-----------------
'   Init
'-----------------
Function_Name = "Sub NLfit_Test1()"
'---------------------
'   WB
'---------------------
Set WB_This = ThisWorkbook

'---------------------
'   WB
'---------------------
With WB_This
'---------------------
'   WB Meta
'---------------------
WB_Name = .Name
WB_Path = .Path
WB_Path = FixPath(WB_Path)
WB_FullName = WB_Path & WB_Name
WB_Version = .Application.Version
WB_VersionNumber = CDbl(WB_This.Application.Version)
Is_WB_Office2007 = (WB_VersionNumber >= 12)
WB_UserLibraryPath = Application.UserLibraryPath

'---------------------
'   This WB as a Data Source
'---------------------
WB_DataSource = FixPath(WB_Path) & WB_Name
WB_DataSource_Full = WB_CON_DS & WB_DataSource & ";"

'---------------------
'   This WB Provider
'---------------------
Select Case WB_Version
Case "12.0"
WB_PR = WB_CON_ACE_PROVIDER
WB_Provider = WB_CON_ACE_PROVIDER
EP2007_XLSX_HDYes = "Extended Properties=""Excel 12.0 Xml;HDR=YES;"""
Case Else
WB_PR = WB_CON_JET_PROVIDER
WB_Provider = WB_CON_JET_PROVIDER
EP2003_XLS_HDYes = "Extended Properties=""Excel 8.0;HDR=YES;"""
End Select

'---------------------
'   WS Names
'---------------------
WS_CNT = WB_This.Worksheets.Count
ReDim msarr_ShtNames(WS_CNT) As String
For i = 1 To WS_CNT
msarr_ShtNames(i) = UCase(Worksheets(i).Name)
Next

'---------------------
'   Names
'---------------------
Names_CNT = .Names.Count

'---------------------
'   Delete Names
'---------------------
For Each mo_NameLoop In .Names
Select Case UCase(mo_NameLoop.Name)
Case "POTENTIAL_SALES", "INNOVATION_P", "IMITATION_Q", "TOTAL_CUMULATIVE_SALES"
'Do Nothing
Case Else
mo_NameLoop.Delete
End Select
Next
End With
'------------------
'   WS Objects
'------------------
If WS_Test Is Nothing Then
Set WS_Test = Sheets(CON_WS_TEST)
End If
'---------------------
'   GetData
'   Put in X and Y Ranges
'---------------------
With WS_Test
Set Rng_CR = .Range("a1").CurrentRegion
Set Rng_X_Values = Rng_CR.Columns(1)
Set Rng_Y_Values = Rng_CR.Columns(2)
End With
'---------------------
'---------------------
MyCase = 2
Select Case MyCase

Case 1

TmpY = Array(1.7788007830714, 1.60653065971263, 1.47236655274101, _
1.36787944117144, 1.28650479686019, 1.22313016014843, _
1.17377394345045, 1.13533528323661, 1.10539922456186, 1.0820849986239)
Case 2

MyTmp = Array(1.7788007830714, 1.60653065971263, 1.47236655274101, _
1.36787944117144, 1.28650479686019, 1.22313016014843, _
1.17377394345045, 1.13533528323661, 1.10539922456186, 1.0820849986239)

'----------------
'   Row Cnt In Range
'----------------
Row_CNT = Rng_Y_Values.Rows.Count

'----------------
'   Redim Array
'----------------
ReDim dbl_Y_Array(0 To Row_CNT - 1)

'----------------
'----------------
For lng = 1 To Row_CNT
dbl_Y_Array(lng - 1) = Rng_Y_Values.Cells(lng)
Next

'----------------
'   Compare Values
'----------------
For lng = 0 To Row_CNT - 1

'----------------
'   Msg Box will FIRE OFF
'----------------
If MyTmp(lng) <> dbl_Y_Array(lng) Then
FYI = MyTmp(lng) & vbCrLf & vbCrLf
FYI = FYI & dbl_Y_Array(lng)
MsgBox FYI
End If

'----------------
'   Msg Box will NOT FIRE OFF
'----------------
If Abs(MyTmp(lng) - dbl_Y_Array(lng)) > 0.0000000001 Then
FYI = MyTmp(lng) & vbCrLf & vbCrLf
FYI = FYI & dbl_Y_Array(lng)
MsgBox FYI
End If

Next

TmpY = MyTmp

End Select
'---------------------
'---------------------
Select Case MyCase
Case 1
n = UBound(TmpY) + 1
Case 2
n = UBound(MyTmp) + 1
End Select

'---------------------
'---------------------
ReDim x(1 To n), y(1 To n)

'---------------------
'---------------------
Select Case MyCase
Case 1
For i = 1 To n
y(i) = TmpY(i - 1)
Next i
Case 2
For i = 1 To n
y(i) = MyTmp(i - 1)
Next i
End Select
'---------------------
'---------------------
TmpX = Array(0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5)
For i = 1 To n
x(i) = TmpX(i - 1)
Next i
ReDim c(1 To 2)
'initialize with a starting point (c1, c2) that you like
c(1) = 0: c(2) = 0
'find the best fit for f(x, c1, c2) = exp(c1*x) + c2
Deriv_Approx = False
iter = 0: itermax = 100
'---------------------
'   Call the Program
'---------------------
Call LMNoLinearFit(x, y, c, ch2, iter, itermax)
'check convegergence
If iter >= itermax Then
Debug.Print "convergence failed. iter ="; iter
Exit Sub
End If
'Output results
Debug.Print "Non-linear regression of:  exp(c1*x) + c2"
For i = 1 To UBound(c)
Debug.Print "c" & i & " = "; c(i)
Next i
Exit Sub
EH_NLfit_Test1:
MsgBox Err.Number & " " & Err.Description, vbCritical, Function_Name
Exit Sub
End Sub```
All of the above aside - this suggestion on your part -

tmp2 = Application.Transpose(Range("B1:B10").Value)

is a home run because it is a 1 dimension Array which eliminates all the LOOP stuff.

Thank you.

I intend to incorporate the transpose in the final version.

regards
John

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•