analyzing graph data excel 07 32 bit windows xp

yonnieboy

New Member
Joined
Jul 21, 2011
Messages
2
I would like to start by saying thank you in advance to the wonderfully helpful community who continue to help vba challenged folks like me with macro coding.

below is part of two columns of data I have(there are 100 data points for my files but I only included half of the points to keep it shorter). I need to graph these points as x and y axis respectively and then afterwards analyze the graph. These data points listed are just one of 100's of data sets that need to be graphed and analyzed so I am using a macro that first imports text into excel (my data points into columns), graphs it, and then analyzes the data. So far I have figured out how to do the first part of that. I still do not know how to correctly graph or analyze the graph. I tried to include in my code graphing the data but that isnt working correctly. The code I have so far is below. There aren't any errors when I run it besides it being unfinished.

Please someone help with this code!!

In short I need to:
graph this data and then analyze it(you can assume these data points start in A1 and B1 respectively).

I need three separate values in the analysis.

1)I need to find the slope averaged over every 6 data points(x,y) for only the first half of the data points listed(50 out of 100 total data points). Below I underlined, italicized and bolded groups to divide up a few of the data points sets used (only 18 of fifty data points that I need to analyze were underlined, italicized and bolded) to get each average slope for clarity's sake.
Then I need to take all the average slopes (there should be 9 average slopes acquired in total (50 points/6)) and find the max slope of all these averages listed.

2) I need to find the absolute maxima and then the relative minima that comes right after that maxima. For example, if the graph starts at 0 on the y axis, goes to 150 then back down to 50 then back up to 100, then down to 25, then up to 75 then down to zero, I only need to know 150 and 50.

3) I need to find the area under the curve for the first half of my data points.

Code:
Private Declare Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long

Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
    Dim lReturn As Long
    lReturn = SetCurrentDirectoryA(szPath)
    ChDirNet = CBool(lReturn <> 0)
End Function


Sub Get_TXT_Files()
'For Excel 2000 and higher
    Dim Fnum As Long
    Dim mysheet As Worksheet
    Dim basebook As Workbook
    Dim TxtFileNames As Variant
    Dim QTable As QueryTable
    Dim SaveDriveDir As String
    Dim ExistFolder As Boolean

    'Save the current dir
    SaveDriveDir = CurDir

    'You can change the start folder if you want for
    'GetOpenFilename,you can use a network or local folder.
    'For example ChDirNet("C:\Users\Ron\test")
    'It now use Excel's Default File Path

    ExistFolder = ChDirNet(Application.DefaultFilePath)
    If ExistFolder = False Then
        MsgBox "Error changing folder"
        Exit Sub
    End If

    TxtFileNames = Application.GetOpenFilename _
    (fileFilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

    If IsArray(TxtFileNames) Then

        On Error GoTo CleanUp

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        'Add workbook with one sheet
        Set basebook = Workbooks.Add(xlWBATWorksheet)
        
        

        'Loop through the array with txt files
        For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

            'Add a new worksheet for the name of the txt file
            Set mysheet = Worksheets.Add(After:=basebook. _
                                Sheets(basebook.Sheets.Count))
            On Error Resume Next
            mysheet.Name = Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
                                    InStrRev(TxtFileNames(Fnum), "\", , 1))
                                    
            On Error GoTo 0
             


            With ActiveSheet.QueryTables.Add(Connection:= _
                        "TEXT;" & TxtFileNames(Fnum), Destination:=Range("A1"))
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1
                
 
 
 'Set to xlDelimited
                .TextFileParseType = xlDelimited
                
   'Set your Delimiter to true
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = True

                
               
                ' Get the data from the txt file
                .Refresh BackgroundQuery:=False
               
               'Column formatting
                Columns("A").ColumnWidth = 15
                Columns("B").ColumnWidth = 10
                Columns("C").ColumnWidth = 15
                Columns("D").ColumnWidth = 16
                Columns("E").ColumnWidth = 12
                Columns("F").ColumnWidth = 18
                Columns("G:K").ColumnWidth = 10
                Columns("L").ColumnWidth = 13
                
                 Range("H1:L11").Select
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
            End With
                

            End With
            
        ActiveSheet.QueryTables(1).Delete
        Next Fnum
      
   'my attempt to graph the data
   
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""Load vs Stiffness"""
    ActiveChart.SeriesCollection(1).Values = "='testwithtao.txt'!$B$3:$B$100"
    ActiveChart.SeriesCollection(1).XValues = "='testwithtao.txt'!$A$3:$A$100"

  'this is to move the columns underneath their proper headings that i create below
  
  Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("A100").Select
    Selection.ClearContents
    Columns("A:A").Select
    Selection.Copy
    Columns("H:H").Select
    ActiveSheet.Paste
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("I:I").Select
    ActiveSheet.Paste

'This cleans up where the data used to be because I used copy instead of cut, not sure why

Columns("A:A").Select
    Selection.ClearContents
    Columns("B:B").Select
    Selection.ClearContents

'I need the date of when the data is graphed
    
Range("B1").Select
ActiveCell.FormulaR1C1 = "=TODAY()"

'Row headings
Rows(1).Insert
Range("A1:N1").HorizontalAlignment = xlCenter
Range("A1:AL1").Select
    Selection.Font.Bold = True
Cells(1, 1) = "Sample Number"
Cells(1, 2) = "Date"
Cells(1, 3).Value = "Node/Internode"
Cells(1, 4).Value = "Relative Humidity"
Cells(1, 5).Value = "Temperature"
Cells(1, 6).Value = "Replication Number"
Cells(1, 7).Value = "Diameter"
Cells(1, 8).Value = "time(S) "
Cells(1, 9).Value = "Load(N)"
Cells(1, 10).Value = "Stiffness()"
Cells(1, 11).Value = "Toughess()"
Cells(1, 12).Value = "Yield Strength()"




        'Delete the first sheet of basebook
        On Error Resume Next
        Application.DisplayAlerts = False
        basebook.Worksheets(1).Delete
        Application.DisplayAlerts = True
        
    
        On Error GoTo 0

CleanUp:

        ChDirNet SaveDriveDir

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

time(S) (x-axis) Load(N) (y-axis)
0 0
0.5895 -0.11382
0.7369 -0.091363
0.8842 0.00096051
1.032 0.093284
1.179 0.18561

1.326 0.27793
1.474 0.30302
1.621 0.27749
1.768 0.25196
1.916 0.22644
2.063 0.20091

2.211 0.17538
2.358 0.14985
2.505 0.12432
2.653 0.098792
2.8 0.073263
2.947 0.047734

3.095 0.022206
3.242 0.0017156
3.39 0.014207
3.537 0.026698
3.684 0.03919
3.832 0.051681
3.979 0.064172
4.126 18.8
4.274 19.296
4.421 33.436
4.569 45.438
4.716 53.719
4.863 60.594
5.011 65.121
5.158 68.428
5.305 77.293
5.453 85.19
5.6 92.841
5.748 100.54
5.895 107.48
6.042 114.5
6.19 122.28
6.337 128.56
6.484 134.82
6.632 140.21
6.779 141.45
6.926 143.33
7.074 146.73
7.221 150.14
7.369 152.49
7.516 154.65
7.663 156.8
7.811 158.91
7.958 154.73
8.105 154.08
8.253 153.26
8.4 152.35
8.548 151.25
8.695 150.34
8.842 150
8.99 129.93
9.137 131.72
9.284 132.75
9.432 133.28
9.579 133.8
9.727 134.33
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
1)I need to find the slope averaged over every 6 data points(x,y) for only the first half of the data points listed(50 out of 100 total data points). Below I underlined, italicized and bolded groups to divide up a few of the data points sets used (only 18 of fifty data points that I need to analyze were underlined, italicized and bolded) to get each average slope for clarity's sake.
Then I need to take all the average slopes (there should be 9 average slopes acquired in total (50 points/6)) and find the max slope of all these averages listed.
Can the average slope of a cluster of 6 results be determined by (y6-y1)/(x6-x1), that is, ignoring any points between the 1st and the 6th points?

As an aside, would the max of a moving average of 6 points' gradient in the first 50 points be any use instead? (It could be a tad easier to programme.)
 
Upvote 0
so far, but I need more info (note red points for maximum and susequent minimum, dotted line showing where area calculation is bound and short red line showing which 6-point gradient is max in first 50 points):
<embed src="http://www.box.net/embed/tasr5oj7pb7b8ey.swf" wmode="opaque" type="application/x-shockwave-flash" allowfullscreen="true" allowscriptaccess="always" width="466" height="400">
 
Last edited:
Upvote 0
Hey P45....my problem is similar to this. At the moment I've managed to do it manually, but I'm using my eyes, which i can't programme vba to do :p hehe. How do you programme it to take the trend line of the maximum gradient? For my manual one I looked and then picked a point. I tried to compare data to see if there was a substantial difference between points, but they are all pretty similar, it's only by looking that I notice the gentle curve. I don't have any code yet (other than the recorded macro I did of me making the graph)

I need to go through the sheets in a workbook and draw this graph for each one.

Many thanks,
 
Upvote 0

Forum statistics

Threads
1,224,514
Messages
6,179,219
Members
452,895
Latest member
BILLING GUY

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top