VBA Run Time

[ameya]

Hi,

My run time is exceptionally long and I'm not sure why. In fact, the graph doesn't even populate. I just get the not responding screen in excel.

How can I make my code more sleek and faster?

Private Sub Submit1_Click()
    If Not IsDate(InitialDate.Value) Then
        MsgBox "Please enter an Initial Date in date format.", vbExclamation, "Error"
        Me.InitialDate.SetFocus
        Exit Sub
    ElseIf Not IsDate(FinalDate.Value) Then
        MsgBox "Please enter a Final Date in date format.", vbExclamation, "Error"
        Me.FinalDate.SetFocus
        Exit Sub
    ElseIf Me.Shift.Value = "" Then
        MsgBox "Please enter a shift.", vbExclamation, "Error"
        Me.Shift.SetFocus
        Exit Sub
    ElseIf Me.MC.Value = "" Then
        MsgBox "Please enter a Model Cell.", vbExclamation, "Error"
        Me.MC.SetFocus
        Exit Sub
    ElseIf Me.InitialDate.Value = "" Then
        MsgBox "Please enter the initial date.", vbExclamation, "Error"
        Me.InitialDate.SetFocus
        Exit Sub
    ElseIf Me.FinalDate.Value = "" Then
        MsgBox "Please enter a final date.", vbExclamation, "Error"
        Me.FinalDate.SetFocus
        Exit Sub
    ElseIf Me.InitialDate.Value > Me.FinalDate.Value Then
        MsgBox "The initial date is greater than the final date.", vbExclamation, "Error"
        Me.InitialDate.SetFocus
        Exit Sub
    ElseIf Me.GraphType.Value = "" Then
        MsgBox "Please enter a graph type.", vbExclamation, "Error"
        Me.GraphType.SetFocus
        Exit Sub
    End If
    
Dim rInitialDate As Range, rFinalDate As Range, rDateRange As Range, Calculation As Worksheet
    
With Worksheets("Calculation")
        Set rInitialDate = .UsedRange.Find(What:=DateValue(InitialDate), After:=.Cells(1, 5), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, SearchFormat:=False)
        Set rFinalDate = .UsedRange.Find(What:=DateValue(FinalDate), After:=.Cells(1, 5), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, SearchFormat:=False)
    If rInitialDate Is Nothing Or rFinalDate Is Nothing Then
        MsgBox "Not able to find both dates"
        Exit Sub
    Else
        Set rDateRange = .Range(rInitialDate, rFinalDate)
    End If
End With
Dim startRow As Integer, endRow As Integer, rDateRangeIndex As Integer, rOEERange As Range
startRow = rInitialDate.Row
endRow = rFinalDate.Row
With Worksheets("Calculation")
    Set startOEECell = .Cells(startRow, 45)
    Set endOEECell = .Cells(endRow, 45)
    Set rOEERange = .Range(startOEECell, endOEECell)
End With
'to create new Range to reflect MC,Shift,Date
With Worksheets("Calculation")
    For i = startRow To endRow Step 1
        If Cells(i, 7) <> MC.Value Or Cells(i, 6) <> Shift.Value _
            Or DateValue(rDateRange(i - (startRow - 1))) < DateValue(InitialDate) _
            Or DateValue(rDateRange(i - (startRow - 1))) > DateValue(FinalDate) Then
                rDateRange(i - (startRow - 1)).Delete
                rOEERange(i - (startRow - 1)).Delete
        End If
    Next i
End With
Dim TTTChtObj As ChartObject
Dim TTTSeries As Series
Set TTTChtObj = ActiveSheet.ChartObjects.Add _
        (Left:=586, Width:=400, Top:=250, Height:=300)
    TTTChtObj.Chart.ChartType = xlBar
Set TTTSeries = TTTChtObj.SeriesCollection.NewSeries
    With TTTSeries
        .XValues = failtime
        .Values = numfail
        .Name = TTTplot
    End With
 
 
End Sub