Auto Correlation Function, Output Range and Regressiona Analysis data to Excel

Hi Experts,

I asked this question about 2 weeks ago, but I couldn't get the help I was looking for, so I will ask my question again.

So I am working on a frequency converter in VB6, and this is the part I need help with.

I have data for about 10 years, and in my flex grid, I have the Date, Value 1, and Value 2.

Each month has a certain number of data sets, and all the data is static, so no changes.

No from my flex grid, I need to get the ranges of the R-squared values between Value 1 and Value 2, such that, without skipping any date, and the values follow a pattern according to the dates, the function should be able to calculate the R-squared values closest to one, and then output the information in this format.

When the user clicks the command button, the command should output the results to excel, yes this is not the challenging part, but this is the problem

The user wants the results in a specified format.

Firstly the auto correlation function needs to work, so that we can get all the ranges of data from the beginning until the end with R-squared values closest to one. The data is sorted by date, and the program cant jump up and down to get the best R-squared values, it has to follow the date order, and within that order, as soon as it reaches a R-squared value closest to one, it should store the start and the end point, and export that to excel. This should go on until the whole data is analyzed, but a loop will take care of that.

Now the format, it should be something like this.

Start Date ----- End Date ----- Plot Date ( this is the middle date from the start and finish, and I need to show the count as well, how many points were between the start and finish) --- R-squared value for that Range with standard Error ----- Slope of that range with the standard Error ------ The Y intercept With the Standard Error and the other in built results that the Regression analysis within the Data analysis gives, such as the upper and lower 95% and all.

I also need a graph, that shows that Plot date VS. The Y intercepts, for the complete data set. This can be obtained from our columns above, like the Plot date column vs the Y-Intercept column.

The part that I urgently need help with is the auto correlation, and reporting those date ranges in excel, with the specified format.

I know how to export data to excel and draw the chart, I should be able to do that.

Now to provide a logical explanation to this scenario,  
As I tried to think of it in my mind, I realized that if the loop goes from the first to the 2nd value, keeping in mind that the values follow a pattern, then obviously we will have a R-squared value very close to 1, but this is not correct.

So to make the problem more simpler, the loop should look up to the first 8 values from the point it begins the loop, as every month has 4 data values, so we can look at 2 months data.

A temp variable can be created that checks how the R-squared value is affected by adding the first 6 values, the first 7 values, or the first 8 values, if the R-squared values keeps increasing as n increases, then we should keep increasing the loop, but if the R-squared value decreases as n increases, then we should keep the value of n that resulted in the highest R-squared value.

This is just a logical explanation to solve this problem,
now I need to put it into code.

So I will need a loop, a temp variable to keep track of n, and the R-squared value.
Might need If case.

I was thinking of doing this, but not sure

Implementing the Max function in excel, along with the correlation to find the max correlation and then report it.

I have the code for implementing the correl function, the code for formatting as well as the chart, but it gives me the R-squared value for the whole grid. I updated it a little bit, and I was able to get it for every row, but the only edition that needs to be made is to get the closest value to 1, and then report the required things.

I have also attached a sample output as well as input file.

If my question is still confusing, then please refer to my previous deleted question
https://www.experts-exchange.com/questions/24109514/Finding-R-squared-automatically-through-searching-range.html

Your help is much awaited and appreciated.
Kind regards.

''' Code for the correl Function
Public Function Corell()
   Dim objApp As Excel.Application
   Dim objBook As Workbook
   Dim objSheet As Worksheet
   On Error Resume Next
   Set objApp = GetObject("excel.application")
   If Err.Number <> 0 Then
      Set objApp = CreateObject("excel.application")
   End If
   Set objBook = objApp.Workbooks.Add
   Set objSheet = objApp.Sheets(1)
 
   Dim j As Integer, high As Integer
   
     
   'This would be the number of data elements
   If keeling_Select = True Then
   high = therowsel
   'High = cbo_RowSelected.List(cbo_RowSelected.ListCount - 1) 'cbo_RowSelected.ListCount - 1
   'For j = cbo_RowSelected.List(0) To cbo_RowSelected.List(cbo_RowSelected.ListCount - 1)
   For j = therow To high
           objSheet.Cells(j, 1).value = grd_result.TextMatrix(j, 2)
           objSheet.Cells(j, 2).value = grd_result.TextMatrix(j, 3)
             For thecol = 1 To grd_result.Cols - 1  'RS_find.Fields.Count
                    grd_result.Col = thecol
                    grd_result.ColSel = thecol
                    grd_result.Row = j
                    grd_result.CellBackColor = &HFFFF&
                    Next thecol
            Next
   
   Else
   
   
   Dim i As Integer
   high = i  ' grd_result.Rows - 1
   i = 2
   For j = 1 To grd_result.Rows - 1
   high = i
           objSheet.Cells(j, 1).value = grd_result.TextMatrix(j, 2)
           objSheet.Cells(j, 2).value = grd_result.TextMatrix(j, 3)
           i = i + 1
            objSheet.Range("a" & high + 1 & ":a" & high + 1).formula = "=Correl(a1:a" & high & ", b1:b" & high & ")^2"
            result = FormatNumber(CDbl(objSheet.Range("a" & high + 1 & ":A" & high + 1).value), 5, vbTrue)
            Debug.Print (result)
        Next
   End If
   
'   objSheet.Range("a" & high + 1 & ":a" & high + 1).formula = "=Correl(a1:a" & high & ", b1:b" & high & ")^2"
'            result = FormatNumber(CDbl(objSheet.Range("a" & high + 1 & ":A" & high + 1).value), 5, vbTrue)
'
   'MsgBox result
   
   objApp.DisplayAlerts = False
   Set objSheet = Nothing
   Set objBook = Nothing
   objApp.Quit
   Set objApp = Nothing
End Function
 
 
''' Code for Max function
Sub MaxValue()
Dim rg As Range
Dim MaxVal As Double
Dim MaxRow As Long, MaxCol As Long
Dim sName As String
Set rg = Selection
MaxVal = Application.Max(rg)
MaxRow = rg.Find(MaxVal, lookat:=xlWhole, LookIn:=xlValues).Row
MaxCol = rg.Find(MaxVal, lookat:=xlWhole, LookIn:=xlValues).Column
sName = rg.Cells(MaxRow - rg.Row + 1, 1)
[AA1:AA4].Value = Application.Transpose(Array(MaxVal, MaxRow, MaxCol, sName))
End Sub
 
 
''' Code for Exporting format and Chart to excel
Private Sub cmd_OutputKeelingPlot_Click()
   Dim objApp As Excel.Application
   Dim objBook As Workbook
   Dim objSheet As Worksheet
   Dim objExcelCI As Excel.Chart
   
   On Error Resume Next
   Set objApp = GetObject("excel.application")
   If Err.Number <> 0 Then
      Set objApp = CreateObject("excel.application")
   End If
   Set objBook = objApp.Workbooks.Add
   Set objSheet = objApp.Sheets(1)
   
   objApp.Visible = True
   objApp.UserControl = True
   objApp.WindowState = xlMaximized
   objApp.DisplayAlerts = False
   
   With objSheet
   .Cells(1, 1).value = " Starting Date "
   .Cells(1, 2).value = " Ending Date "
   .Cells(1, 3).value = " Plot Date "
   .Cells(1, 4).value = " n "
   .Cells(1, 5).value = " R-squared "
   .Cells(1, 6).value = " Standard Error "
   .Cells(1, 7).value = " Slope "
   .Cells(1, 8).value = " Standard Error "
   .Cells(1, 9).value = " Y-intercept "
   .Cells(1, 10).value = " Standard Error "
   
   ''' Have the code for the loop  that gives all the values to these columns and defiens the range
   
   .Range("A1:k1").Select
   
   With Selection
   
  .HorizontalAlignment = xlCenter
   .Range.VerticalAlignment = xlBottom
   .Range.WrapText = False
   .Range.Orientation = 0
   .Range.AddIndent = False
   .Range.IndentLevel = 0
   .Range.ShrinkToFit = True
   .Range.ReadingOrder = xlContext
   .Range.MergeCells = False
   .Range.Borders(xlDiagonalDown).LineStyle = xlNone
   .Range.Borders(xlDiagonalUp).LineStyle = xlNone
   
   With .Range.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With .Range.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With .Range.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With .Range.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    .Range.Borders(xlInsideVertical).LineStyle = xlNone
    .Range.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    End With
    
    .Range("A1:K1").Select
    
    With Selection
    
    .Range.Font.Bold = True
    .Range.Borders(xlDiagonalDown).LineStyle = xlNone
    .Range.Borders(xlDiagonalUp).LineStyle = xlNone
    
    With .Range.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With .Range.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With .Range.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With .Range.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
   End With
   End With
 
   Set objExcelCI = objExcelW.Charts.Add
   With objExcelCI
          
    .ChartType = xlXYScatter
    .SetSourceData Source:=Sheets("Sheet1").Range("D57:D66,J57:J66"), _
        PlotBy:=xlColumns
        
    .Location Where:=xlLocationAsNewSheet, Name:="Keeling Plot"
    
    .HasTitle = True
    .ChartTitle.Characters.Text = "Keeling Plot"
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Y-Intercept"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Plot Date"
    .HasLegend = False
    
    .PlotArea.Select
 
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    
    Selection.Fill.OneColorGradient Style:=msoGradientDiagonalUp, Variant:=3, _
        Degree:=0.231372549019608
        
    With Selection
        .Fill.Visible = True
        .Fill.ForeColor.SchemeColor = 43
    End With
    
    .SeriesCollection(1).Select
    
    With Selection.Border
        .ColorIndex = 1
        .Weight = xlHairline
        .LineStyle = xlDot
    End With
    
    With Selection
        .MarkerBackgroundColorIndex = 2
        .MarkerForegroundColorIndex = 1
        .MarkerStyle = xlCircle
        .Smooth = False
        .MarkerSize = 5
        .Shadow = False
    End With
    
    End With
       
       
   Set objSheet = Nothing
   Set objBook = Nothing
   Set objApp = Nothing
   Set objExcelCI = Nothing
   
End Sub

Select allOpen in new window

Sample-Output-For-keeling-Plot.xls
Keeling-Plot-data.xls