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

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
      Dim current_max, max As Double ' This compares the result with the max
   Dim n As Integer
   high = grd_result.Rows - 1
   For j = 1 To high
   n = j
           objSheet.Cells(j, 1).value = grd_result.TextMatrix(j, 2)
           objSheet.Cells(j, 2).value = grd_result.TextMatrix(j, 3)
            objSheet.Range("a" & n + 1 & ":a" & n + 1).formula = "=Correl(a1:a" & n & ", b1:b" & n & ")^2"
            result = FormatNumber(CDbl(objSheet.Range("a" & n + 1 & ":A" & n + 1).value), 5, vbTrue)
            
            If result > current_max Then
            max = result
            ElseIf current_max > result Then
            max = current_max
            End If
        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)
   
  
   objApp.DisplayAlerts = False
   Set objSheet = Nothing
   Set objBook = Nothing
   objApp.Quit
   Set objApp = Nothing
End Function
 
 
'''''
 
Private Sub cmd_OutputKeelingPlot_Click()
 
Call Corell
 
   Dim objApp As Excel.Application
   Dim objBook As Workbook
   Dim objSheet As Worksheet
   Dim objExcelCI As Excel.Chart
   Dim high As Integer
   
   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, 2).value = " Starting Date "
   .Cells(1, 3).value = " Ending Date "
   .Cells(1, 4).value = " Plot Date "
   .Cells(1, 5).value = " n "
   .Cells(1, 6).value = " R-squared "
   .Cells(1, 7).value = " Standard Error "
   .Cells(1, 8).value = " Slope "
   .Cells(1, 9).value = " Standard Error "
   .Cells(1, 10).value = " Y-intercept "
   .Cells(1, 11).value = " Standard Error "
   
   ''' Have the code for the loop  that gives all the values to these columns and defiens the range
   
   ''' High = end row from Autocorrellation
   high = 10
   
   .Range("B1:K" & high).Select
   
   With Selection
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlBottom
   .WrapText = False
   .Orientation = 0
   .AddIndent = False
   .IndentLevel = 0
   .ShrinkToFit = True
   .ReadingOrder = xlContext
   .MergeCells = False
   .Borders(xlDiagonalDown).LineStyle = xlNone
   .Borders(xlDiagonalUp).LineStyle = xlNone
   
   With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    End With
    
    .Range("B1:K1").Select
    
    .Columns.AutoFit
    
    With Selection
    .Font.Bold = True
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    
   End With
   End With
 
   Set objExcelCI = objExcelW.Charts.Add
   With objExcelCI
          
    .ChartType = xlBarStacked
    .SetSourceData Source:=Sheets("Sheet1").Range("E1:E" & high & "J1:J" & high), 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
    
    With .PlotArea.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
   
    With .SeriesCollection(1).Border
        .ColorIndex = 1
        .Weight = xlHairline
        .LineStyle = xlDot
    End With
    
    With .SeriesCollection(1)
        .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