Optimize a slow code...

Hi guys, I am new to VBA, I have done a code that does the following :
get me all the speed variations and classify each of them to create a sort of histogram.

Since a am pretty new to VBA, and to coding in general, my code is big and slow.
If anyone could give me some nice pointer on how to optimize it will be very appreciated!
(I got like 9817398172 for loops....)

The code do this sequence :
get the time and speed difference
get the variation on these datas.
find create duplicate of the datas if its on the same slope
delete the duplicates
find variation that has a difference of speed too small depending on the users input
classify each data depending on histogram resolution
End

Sub SlopeCalculator2()

'Run "Doit"
'Application.ScreenUpdating = False

Dim PasteAreaRow, SpeedThreshold, HistogramResolution, StartingIndex, EndingIndex, Count As Integer
Dim PastTime, CurrentTime, DeltaTime, DeltaSpeed, AverageValue, LastAverageValue, MinValue, MaxValue, Binrange As Double


'Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Application.DisplayStatusBar = True

Range("A3").Select
Selection.End(xlDown).Select
PasteAreaRow = ActiveCell.Row


For i = 3 To PasteAreaRow
PastTime = TimeValue(Range("A" & i - 1).Value)
CurrentTime = TimeValue(Range("A" & i).Value)
DeltaTime = (CurrentTime - PastTime) * 24 'gets the time in hour

PastSpeed = Range("B" & i - 1).Value
CurrentSpeed = Range("B" & i).Value
DeltaSpeed = CurrentSpeed - PastSpeed

Range("D" & i).Value = DeltaSpeed / DeltaTime 'variation of speed in a certain amount of time

Next i
For i = 3 To PasteAreaRow
    For j = i To i + 1000
        If Range("D" & i).Value > 0 And Range("D" & j).Value < 0 Then 'find the inflexion points
        AverageValue = Application.Average(Range(Cells(i, 4), Cells(j - 1, 4))) 'calculate the average speed variation in between the infelxions
            If AverageValue > 0 And Range("E" & i - 1).Value > 0 Then
                AverageValue = LastAverageValue 'If the calculated values are the same sign, make them the same to remove them easier.
                End If
                Range("E" & i).Value = AverageValue
                'Range("F" & i).Value = Abs(AverageValue)
        Exit For
        ElseIf Range("D" & i).Value < 0 And Range("D" & j).Value > 0 Then
        AverageValue = Application.Average(Range(Cells(i, 4), Cells(j - 1, 4)))
            If AverageValue < 0 And Range("E" & i - 1).Value < 0 Then
                AverageValue = LastAverageValue
                End If
                Range("E" & i).Value = AverageValue
                'Range("F" & i).Value = Abs(AverageValue)
        Exit For
       End If
       LastAverageValue = AverageValue
    Next j
Next i

'Run "Doit"
'Application.ScreenUpdating = False
    
SpeedThreshold = Application.InputBox _
             (Prompt:="Please enter the minimum difference in speed on a slope (Speed threshold in Miles/hours).", _
                    Title:="Speed threshold", Type:=1)
For i = PasteAreaRow To 3 Step -1
If Range("E" & i).Value = Range("E" & i - 1).Value Then 'remove values on top of one another that are the same
Range("E" & i).Value = ""
End If
If Range("F" & i).Value = Range("F" & i - 1).Value Then 'remove values on top of one another that are the same
Range("F" & i).Value = ""
End If
Next i

For i = 3 To PasteAreaRow
    If Range("E" & i).Value <> "" Then
    StartingIndex = i
        For j = i + 1 To i + 20
        If Range("E" & j).Value <> "" Then
            EndingIndex = j - 1
            Exit For
            End If
        Next j 'get the row value of these datas.
    DeltaSpeed = Range("B" & j).Value - Range("B" & i).Value 'remove small variations of speed
        If Abs(DeltaSpeed) < SpeedThreshold Then
        Range("E" & i).Value = ""
        Range("E" & j).Value = ""
        End If
    End If
Next i
    

MaxValue = Application.Max(Range(Cells(1, 5), Cells(1000, 5)))
MinValue = Application.Min(Range(Cells(1, 5), Cells(1000, 5)))
'get the max and min to create a "histogram"

'Run "Doit"
'Application.ScreenUpdating = False

HistogramResolution = Application.InputBox _
             (Prompt:="Please enter the Desired resolution for the histogram (quantity of bins).", _
                    Title:="Histogram Resolution", Type:=1)
For j = 0 To HistogramResolution
Binrange = (MaxValue - MinValue) / (HistogramResolution - 1)
Range("G" & j + 3).Value = MinValue + Binrange * j
'MsgBox MinValue & " " & MaxValue & " " & Binrange
Next j

For j = 0 To HistogramResolution
Count = 0
  CurrentBinMin = Range("G" & j + 3).Value - 1
  CurrentBinMax = Range("G" & j + 4).Value - 1
  'MsgBox CurrentBinMin & " " & CurrentBinMax
  For k = 3 To PasteAreaRow
  If CurrentBinMax = -1 Or CurrentBinMin = -1 Then
  Exit For
  End If
  CurrentAverage = Range("E" & k).Value
  If CurrentAverage <> 0 And CurrentAverage > CurrentBinMin And CurrentAverage <= CurrentBinMax Then
  Count = Count + 1
  End If
  Next k
Range("H" & j + 3).Value = Count
Next j
        
''
''For i = 3 To PasteAreaRow
''If Range("F" & i).Value > 0 Then
''Range("G" & i).Value = True
''Else
''Range("G" & i).Value = False
''End If
''
'''CurrentDiffTime = Range("D" & i).Value
'''CurrentDiffSpeed = Range("E" & i).Value
'''If CurrentDiffTime <> 0 Then
'''    For j = i To i + 10
'''    SlopeEnd = Range("E" & j).Value
'''        If CurrentDiffTime > 0 And SlopeEnd < 0 Then
'''            SlopeEndRow = j
'''        End If
'''
'''        If CurrentDiffTime < 0 And SlopeEnd > 0 Then
'''            SlopeEndRow = j
'''        End If
'''    Next j
'''Range("G" & i).Value = j - i
'''Else
'''End If
''Next i
''
''PastValueSign = -1
''For i = 3 To PasteAreaRow
''ValueSign = Range("G" & i).Value
''    If ValueSign <> PastValueSign Then
''    Range("H" & i).Value = i - 1
''    End If
''PastValueSign = Range("G" & i).Value
''Next i
'    Columns("H:H").Select
'    Selection.SpecialCells(xlCellTypeBlanks).Select
'    Selection.Delete Shift:=xlUp
'    Range("I1").Select
'
'Range("H3").Select
'Selection.End(xlDown).Select
'PasteAreaRow = ActiveCell.Row
'pasteAreaColumn = ActiveCell.Column
'
'PastColumnValue = -1
'For i = 1 To PasteAreaRow
'ColumnValue = Range("H" & i).Value - 1
'
'If ColumnValue <> PastColumnValue Then
'Range("I" & i).Value = ColumnValue + 1
'End If
'PastColumnValue = Range("H" & i).Value
'Next i
'
'    Columns("I:I").Select
'    Selection.SpecialCells(xlCellTypeBlanks).Select
'    Selection.Delete Shift:=xlUp
''
'Range("H3").Select
'Selection.End(xlDown).Select
'PasteAreaRow = ActiveCell.Row
'pasteAreaColumn = ActiveCell.Column
'
'For i = 1 To PasteAreaRow
'RowIndex = Range("H" & i).Value
'NextRowIndex = Range("H" & i + 1).Value
'dblAverage = Application.WorksheetFunction.Average(Worksheets(" Sheet1").Range("F" & RowIndex + 1 & ":F" & NextRowIndex))
'Range("J" & i).Value = dblAverage
'Next i


    
    

'Run "Doit"

'Application.Calculation = xlCalculationAutomatic
End Sub
'Calculate the average of a serie of slopes to get the average acceleration/decceleration.


Sub DoIt()
Application.ScreenUpdating = True
    With Sheet2.Shapes("Rectangle 1")
         .Visible = msoTrue = (Not Sheet2.Shapes("Rectangle 1").Visible)
    End With
'Forces TextBox to show while code is running
Sheet1.Select
Sheet2.Select
End Sub
Sub SlopeCalculator3()

'Run "Doit"
'Application.ScreenUpdating = False

'Dim PasteAreaRow, SpeedThreshold, HistogramResolution, StartingIndex, EndingIndex, Count As Integer
Dim PastTime, CurrentTime, DeltaTime, DeltaSpeed, AverageValue, LastAverageValue, MinValue, MaxValue, Binrange As Double
Dim DeltaSpeedVarRay(10000) As Double

'Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = True
'Application.DisplayStatusBar = True

'Range("A3").Select
'Selection.End(xlDown).Select
'PasteAreaRow = ActiveCell.Row

TimeRay = Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
SpeedRay = Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value

For i = LBound(TimeRay, 1) To UBound(TimeRay, 1)

PastTime = TimeRay(i, 1)
CurrentTime = TimeRay(i, 1)
DeltaTime = CurrentTime - PastTime


PastSpeed = TimeRay(i, 1)
CurrentSpeed = TimeRay(i, 1)
DeltaSpeed = CurrentSpeed - PastSpeed

SpeedVar = DeltaSpeed / DeltaTime + 1 'variation of speed in a certain amount of time

DeltaSpeedVarRay(i) = SpeedVar

Next i

Range("C1:C" & UBound(DeltaSpeedVarRay) + 1) _
    = WorksheetFunction.Transpose(DeltaSpeedVarRay)
End Sub

edit :
here is a piece of sample data:

UTC	SPEED
3/27/2013 7:46	0
3/27/2013 7:46	9.7
3/27/2013 7:46	11.2
3/27/2013 7:46	13.5
3/27/2013 7:47	14.2
3/27/2013 7:47	16.4
3/27/2013 7:47	19.1
3/27/2013 7:47	20.6
3/27/2013 7:47	22.3
3/27/2013 7:47	24.6
3/27/2013 7:48	26.4
3/27/2013 7:48	28.3
3/27/2013 7:48	29.6
3/27/2013 7:48	31.1
3/27/2013 7:48	32.5
3/27/2013 7:48	33
3/27/2013 7:49	33