vba - Using Excel macro to find point of slope change

Question

EDIT: I have solved the issues that were addressed in this post. Thanks to everyone who helped. The basic solution was misplacing my code in the wrong module.

I have some X & Y data for Excel chart and need to find the location of the corner in the graph.

Using a macro I started to evaluate the data but haven't been able to find the reasonable way to find a stark change in the slope to identify the corner.

I have one column with X values and another with Y values.

If you look at the circle in the corner, I'm looking to find the location of that corner. it doesn't have to be perfectly accurate but as good as possible.

Some of this code I found on other answers, but most of it was modified from the macro recorder. I'm still trying to make it work to get first and second derivatives. That's what those first two large blocks of code are trying to accomplish. I was hoping to use a local max or something like that in the derivatives to determine the corners location.

Option Explicit
Option Compare Text
Sub FindSlopeIncrease()
Dim lastrow As Long
Dim chtObj As ChartObject
Dim Slope As Double
Dim rng As Range
Dim Start As Integer
Dim Load As Integer
Dim DDate As String
Dim f As Variant
Dim src As Object
Dim myfile As Variant
Dim i As Integer
Dim mysheet As Variant
Dim x As Integer
Dim savefile As Workbook

Let Slope = 0
Let Start = 400 'cell value to start searching from

DDate = Date

Call Lights_Off 'Turns off screenupdating and warning messages to increase speed of macro

myfile = Application.GetOpenFilename(MultiSelect:=True) 'Returns filename as string to open .xls spreadsheets.
    If TypeName(myfile) = "False" Then
        Exit Sub
    End If

    Set savefile = Workbooks.Add
    ActiveWorkbook.Activate
    ActiveSheet.Range("A1") = "Load (N)"

    If IsArray(myfile) Then
        For i = LBound(myfile) To UBound(myfile)
        'Runs array to open multiple files at a time

            Set src = Workbooks.Open(myfile(i), ReadOnly:=True)

            Worksheets(1).Activate

            For Each chtObj In ActiveSheet.ChartObjects
                chtObj.Delete
            Next

            lastrow = ActiveSheet.UsedRange.Rows.Count + 1

            ActiveSheet.Columns(6).ClearContents
            ActiveSheet.Columns(7).ClearContents
            ActiveSheet.Columns(8).ClearContents
            ActiveSheet.Columns(9).ClearContents

            ActiveSheet.Range("C8:C" & lastrow).Copy
            ActiveSheet.Range("F8:F" & lastrow).PasteSpecial
            ActiveSheet.Range("C8").Copy
            ActiveSheet.Range("F8:F" & lastrow).PasteSpecial Operation:=xlPasteSpecialOperationSubtract
            ActiveSheet.Range("F6") = "Extension(mm)"

            For x = Start To lastrow
                Set rng = Range("A" & x, "A" & x + 2)
                If x = Start Then
                    Slope = WorksheetFunction.Slope(rng, rng.Offset(0, 1))
                    GoTo 1
                ElseIf WorksheetFunction.Slope(rng, rng.Offset(0, 1)) - 400 >= Slope Then
                    MsgBox "Slope = " & Slope & " Cell value = " & x
                    Let Load = Range("A" & x)
                    MsgBox "Can Contact load = " & Load & "N"
                    savefile.Activate
                    ActiveWorkbook.ActiveSheet.Range("A" & i + 1) = [Load]
                    GoTo 2
                End If

1:          Slope = WorksheetFunction.Slope(rng, rng.Offset(0, 1))
            Next x
2:
            src.Close False
            'Closes Spreadsheet after data has been saved
            Set src = Nothing
            Next i 'Goes to next "i": runs the next file in line for multiple file selections
                Else
            End If
ErrHandler:
            Application.EnableEvents = True
            Application.ScreenUpdating = True


ActiveWorkbook.SaveAs Filename:=Month(DDate) & Day(DDate) & Year(DDate) & " Can Contact Load Summary", FileFormat:=xlWorkbookNormal, CreateBackup:=False

    ActiveWorkbook.Close

    Call Lights_On 'Turns screenupdating and Warning messages back on
End Sub

Public Sub Lights_Off()

    '\\ Turns OFF screen updating and warning messages to speed up macro.

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

End Sub
Public Sub Lights_On()

    '\\ Turns ON screen updating and warning messages when macro stops.

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub

标签： vbaexcelderivative