Urgent help needed - "Runtime error 9: subscript out of range"

[lostman]

Hi all,


I am currently finishing my master thesis including simulations and have run into an issue.


I am running simulations through a "Monte Carlo" macro that was imported from another work book. After each run I receive the error message "Runtime error 9: subscript out of range". When I try to debug the following is showed, with the highlighted error area in the second row of:

wb.Sheets(number_of_formulas * 2 + 1).Delete

Option Explicit


' MonteCarlito - www.montecarlito.com
' Martin Auer, 2005
' Distributed under terms of GNU General Public License


Sub simulate()
    Dim sel As Range
    Set sel = Application.Selection
    If sel.Cells.Columns.Count < 2 Or sel.Cells.Rows.Count < 2 Then
        MsgBox "You need to select a rectangular region, with the number of trials in the upper left cell, with the simulation formulas in the rest of the upper row, and with some cells selected beneath."
        Exit Sub
    End If
    
    Dim sel_tmp As Range
    Dim create_histogram As Boolean
    create_histogram = False
    If sel.Cells(1, 1).Font.Bold = True Then
        create_histogram = True
    End If
    
    Dim number_of_formulas As Long
    Dim number_of_trials As Long
    Dim number_of_outputrows As Long
    Dim runs() As Variant
    Dim i As Long
    Dim j As Long
    Dim tmp() As Variant
    Dim high_speed As Boolean
    high_speed = False
    
    number_of_formulas = sel.Cells.Columns.Count - 1
    number_of_trials = sel.Cells(1, 1)
    number_of_outputrows = sel.Cells.Rows.Count - 1
    
    Dim mean_values() As Variant
    Dim var_values() As Variant
    Dim stddev_values() As Variant
    Dim stderr_values() As Variant
    Dim max_values() As Variant
    Dim min_values() As Variant
    Dim median_values() As Variant
    Dim skew_values() As Variant
    Dim kurt_values() As Variant
    
    ReDim mean_values(number_of_formulas)
    ReDim var_values(number_of_formulas)
    ReDim stddev_values(number_of_formulas)
    ReDim stderr_values(number_of_formulas)
    ReDim max_values(number_of_formulas)
    ReDim min_values(number_of_formulas)
    ReDim median_values(number_of_formulas)
    ReDim skew_values(number_of_formulas)
    ReDim kurt_values(number_of_formulas)
    
    If number_of_trials = 0 Then
        MsgBox "Put the number of trials in the upper left cell of your selection. If it is negative, simulation is run in high-speed-mode with minimized windows."
        Exit Sub
    End If
    If number_of_trials < 0 Then
        number_of_trials = Math.Abs(number_of_trials)
        high_speed = True
    End If
    
    ReDim runs(number_of_formulas, number_of_trials)
    ReDim tmp(number_of_trials)
    
    
    ' Run simulation
    If high_speed = True Then Application.Visible = False
    For i = 1 To number_of_trials
        Application.Calculate
        For j = 1 To number_of_formulas
            runs(j, i) = sel.Cells(1, 1 + j)
        Next j
        If high_speed = False And (i Mod 10 = 0 Or i = number_of_trials) Then
            sel.Cells(1, 1) = i
        End If
    Next i
    If high_speed = True Then Application.Visible = True
    
    ' Calculate statistics
    For i = 1 To number_of_formulas
        Call arrcpy(runs, tmp, i, number_of_trials)
        mean_values(i) = mean(tmp)
        stddev_values(i) = stddev(tmp)
        stderr_values(i) = stddev_values(i) / Math.Sqr(number_of_trials)
        var_values(i) = stddev_values(i) * stddev_values(i)
        skew_values(i) = skewness(tmp)
        kurt_values(i) = kurtosis(tmp)
        
        median_values(i) = mmedian(tmp)
    Next i
    
    ' Output
    For i = 1 To number_of_outputrows
        If i = 1 Then
            sel.Cells(1 + i, 1) = "Mean"
            Call out(1 + i, 2, mean_values(), sel)
        ElseIf i = 2 Then
            sel.Cells(1 + i, 1) = "Standard error"
            Call out(1 + i, 2, stderr_values(), sel)
        ElseIf i = 3 Then
            sel.Cells(1 + i, 1) = "Median"
            Call out(1 + i, 2, median_values(), sel)
        ElseIf i = 4 Then
            sel.Cells(1 + i, 1) = "Standard deviation"
            Call out(1 + i, 2, stddev_values(), sel)
        ElseIf i = 5 Then
            sel.Cells(1 + i, 1) = "Variance"
            Call out(1 + i, 2, var_values(), sel)
        ElseIf i = 6 Then
            sel.Cells(1 + i, 1) = "Skewness"
            Call out(1 + i, 2, skew_values(), sel)
        ElseIf i = 7 Then
            sel.Cells(1 + i, 1) = "Kurtosis"
            Call out(1 + i, 2, kurt_values(), sel)
                
                
        End If
    Next i
    
    ' Create histograms
    If create_histogram = True Then
        Dim wb As Workbook
        Set wb = Workbooks.Add
              
        Dim lmin As Variant
        Dim lmax As Variant
        Dim interval As Variant
        Dim i_tmp As Long
        
        For i = number_of_formulas To 1 Step -1
            Dim hist(50) As Variant
            Dim ws As Worksheet
            Set ws = wb.Sheets.Add
            ws.Name = CStr(i)
            
            Call arrcpy(runs, tmp, i, number_of_trials)
            
            lmin = min(tmp)
            lmax = max(tmp)
            lmax = lmax + 1 / 1000 * (lmax - lmin)
            interval = (lmax - lmin) / 50
            
            Erase hist
            For j = 1 To number_of_trials
              i_tmp = CLng((tmp(j) - lmin) / interval - 0.5)
              hist(i_tmp + 1) = hist(i_tmp + 1) + 1
            Next j
                
            For j = 1 To UBound(hist)
                ws.Cells(j, 1) = lmin + (j - 1) * interval
                ws.Cells(j, 2) = hist(j)
            Next j
            
            Dim r1 As Range
            Dim r2 As Range
            Set r1 = Range("A1", "A50")
            Set r2 = Range("B1", "B50")
            
            Charts.Add
            ActiveChart.ChartType = xlColumnClustered
            ActiveChart.SetSourceData Source:=r2, PlotBy:=xlColumns
            ActiveChart.Name = "Diagram " + CStr(i)
            ActiveChart.SeriesCollection(1).XValues = r1
            With ActiveChart.ChartGroups(1)
                .GapWidth = 0
            End With
        Next i
        Application.DisplayAlerts = False
        wb.Sheets(number_of_formulas * 2 + 1).Delete
        wb.Sheets(number_of_formulas * 2 + 1).Delete
        wb.Sheets(number_of_formulas * 2 + 1).Delete
        Application.DisplayAlerts = True
    End If
End Sub


Sub arrcpy(ByRef a() As Variant, ByRef b() As Variant, i As Long, uj As Long)
    Dim j As Long
    For j = 1 To uj
        b(j) = a(i, j)
    Next j
End Sub


Function mmedian(a() As Variant) As Variant
    Call QuickSort(a)
    Dim i As Long
    i = CLng(UBound(a) / 2)
    mmedian = a(i)
End Function


Function min(a() As Variant) As Variant
    Dim i As Long
    min = a(1)
    For i = 1 To UBound(a)
        If a(i) < min Then min = a(i)
    Next i
End Function


Function max(a() As Variant) As Variant
    Dim i As Long
    max = a(1)
    For i = 1 To UBound(a)
        If a(i) > max Then max = a(i)
    Next i
End Function


Function mean(a() As Variant) As Variant

Since I am not familiar with VBA and need to proceed with my master thesis which builds on this simulation I need your help urgently.


Please let me know if you need more information to help me solving this issue.




Thank you in advance.




Best,
Lukas

 

[Fluff]

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
Please provide links to ALL other sites where you have asked this question