Problems Consolidating Range for Analysis ToolPak Regression

[nb-]

I am trying to do a number of regressions in excel (2010) using the analysis toolpak regression functions through vba;

The sheets with the data haave a number of columns with a heading (sometimes a gap) and formulas underneath that return either a value or "" (blank). The regression is against variously 1, 3 or 4 variable.

Heading 1
Formula Returning Value
Formula Returning Value
Formula Returning Value
Formula Return ""
Formula Return ""
Formula Return ""
Formula Returning Value
Formula Return ""
etc.

Obviously if I try and pass this range to the analysis toolpak, it give the error; Regression 0 Input range contains non-numeric data. because of all the "" blanks.

Is there a cunning way of using unions and intersect to parse the values to the regression function that I have failed to think of?

My immediate though was to read the data into arrays and consolidate the arrays, but this didn't work either its throwing the error; Regression - Input Y range must be a contiguous reference

Am I calling the regression function in an odd way such that it does not like my arrays as parameters or doing something else silly?

Can anyone spot what I am doing wrong or have any ideas for a way round my problems? I don't really want to have to copy the values to a new set of columns and operate off the new value columns, which is about all I can think of to do.

Workbook has a reference to ATPVBAEN.XLAM

[side point as you will see I was also having problems with getting the number of dimensions of the array after it has been transposed]

'// Regression parameter constants
Const bol_regress_const_is_0 As Boolean = False
Const bol_data_has_headers As Boolean = True
Const var_confid  As Variant = True '// true menas 95% only, otherwise specify a confidence level.
Const bol_residuals As Boolean = True '// show residuals
Const bol_sresuiduals As Boolean = True '// show standardized residuals
Const bol_rplots As Boolean = False '// plot residuals
Const bol_lplots As Boolean = False '// Line fit plot (prediction vs. actual)
Const var_rountrng As Variant = False '//???? output range for ?? seems to have no effect.
Const bol_nplots As Boolean = False '// Normal probability plot of Ys cumulative vs. percentile + associated data
Const var_poutrng As Variant = False '// ???? output range for??
'//-----------------------------------------

Sub test_regress()
Call run_regression_2("P5", "X5", "P6:P344", "X6:X344", "AY6")
End Sub


Private Sub run_regression_2(str_x_label As String, str_y_label As String, str_xs_rng As String, str_ys_rng As String, str_destination_range As String)
'//Sub that actually calls the regression function using constants stored above and passed parameters
'//Analysis toolpak must be loaded

Dim arr_ys() As Variant
Dim arr_xs() As Variant
Dim arr_new_ys() As Variant
Dim arr_new_xs() As Variant

Dim i As Long
Dim j As Long
Dim k As Long

Dim bol_blanks_in_row As Boolean
bol_blanks_in_row = False

arr_ys = Application.Union(ActiveSheet.Range(str_y_label), ActiveSheet.Range(str_ys_rng))
arr_xs = Application.Union(ActiveSheet.Range(str_x_label), ActiveSheet.Range(str_xs_rng))

'// Y array
'// filter rows containing blanks from array to new array.
ReDim arr_new_ys(LBound(arr_ys, 1) To UBound(arr_ys, 1), LBound(arr_ys, 2) To UBound(arr_ys, 2))
k = LBound(arr_ys, 1)
'// look through array
For i = LBound(arr_ys, 1) To UBound(arr_ys, 1)
    '// if blank in row, set market
    For j = LBound(arr_ys, 2) To UBound(arr_ys, 2)
        If arr_ys(i, j) = "" Then
            bol_blanks_in_row = True
        End If
    Next j
    '// If market not set copy row to new array
    If bol_blanks_in_row = False Then
        '//Debug.Print "blanks in row"; i; "false"
        For j = LBound(arr_ys, 2) To UBound(arr_ys, 2)
        arr_new_ys(k, j) = arr_ys(i, j)
        k = k + 1
        Next j
    End If
    '// else ignore and reset market
    bol_blanks_in_row = False
Next i


'// Can only redim preserve last dimension of an array, hence all transpose work.  Also transpose will convert 1D array in 2D to a true 1D array.
arr_ys = Application.Transpose(arr_new_ys)
'// Check if arr_ys is 1D or not
If Array_No_Dims(arr_ys) = 1 Then
    ReDim Preserve arr_ys(LBound(arr_ys) To k - 1)
    arr_new_ys = Application.Transpose(arr_ys)
'//    ReDim Preserve arr_new_ys(LBound(arr_new_ys) To UBound(arr_new_ys), 1 To 1)
Else
    ReDim Preserve arr_ys(LBound(arr_ys, 1) To UBound(arr_ys, 1), LBound(arr_ys, 2) To k - 1)
    arr_new_ys = Application.Transpose(arr_ys)
End If

'//ReDim Preserve arr_new_ys(1 To 337, 1 To 1)
'//ReDim Preserve arr_new_ys(LBound(arr_ys, 1) To k - 1, LBound(arr_ys, 2) To UBound(arr_ys, 2))



'#######
'// X array
'// filter rows containing blanks from array to new array.
ReDim arr_new_xs(LBound(arr_xs, 1) To UBound(arr_xs, 1), LBound(arr_xs, 2) To UBound(arr_xs, 2))
k = LBound(arr_xs, 1)
'// look through array
For i = LBound(arr_xs, 1) To UBound(arr_xs, 1)
    '// if blank in row, set market
    For j = LBound(arr_xs, 2) To UBound(arr_xs, 2)
        If arr_xs(i, j) = "" Then
            bol_blanks_in_row = True
        End If
    Next j
    '// If market not set copy row to new array
    If bol_blanks_in_row = False Then
        '//Debug.Print "blanks in row"; i; "false"
        For j = LBound(arr_xs, 2) To UBound(arr_xs, 2)
        arr_new_xs(k, j) = arr_xs(i, j)
        k = k + 1
        Next j
    End If
    '// else ignore and reset market
    bol_blanks_in_row = False
Next i


'// Can only redim preserve last dimension of an array, hence all transpose work.  Also transpose will convert 1D arrax in 2D to a true 1D array.
arr_xs = Application.Transpose(arr_new_xs)
'// Check if arr_xs is 1D or not
If Array_No_Dims(arr_xs) = 1 Then
    ReDim Preserve arr_xs(LBound(arr_xs) To k - 1)
    arr_new_xs = Application.Transpose(arr_xs)
'//    ReDim Preserve arr_new_xs(LBound(arr_new_xs) To UBound(arr_new_xs), 1 To 1)
Else
    ReDim Preserve arr_xs(LBound(arr_xs, 1) To UBound(arr_xs, 1), LBound(arr_xs, 2) To k - 1)
    arr_new_xs = Application.Transpose(arr_xs)
End If

'//ReDim Preserve arr_new_ys(1 To 337, 1 To 1)
'//ReDim Preserve arr_new_ys(LBound(arr_ys, 1) To k - 1, LBound(arr_ys, 2) To UBound(arr_ys, 2))

'// Regression parameters
'// regress(ys,xs,
'//         constant,labels,confid,soutrng,
'//         residuals,sresuiduals,rplots,lplots,rountrng,nplots,poutrng)

Call regress(arr_ys, _
                            arr_xs, _
                            False, True, False, ActiveSheet.Range(str_destination_range) _
                            , bol_residuals, bol_sresuiduals, bol_rplots, bol_lplots, var_rountrng, bol_nplots, var_poutrng)

'Application.Run "regress", Application.Union(ActiveSheet.Range(str_y_label), ActiveSheet.Range(str_ys_rng)), _
                            Application.Union(ActiveSheet.Range(str_x_label), ActiveSheet.Range(str_xs_rng)), _
                            False, True, False, ActiveSheet.Range(str_destination_range) _
                            , bol_residuals, bol_sresuiduals, bol_rplots, bol_lplots, var_rountrng, bol_nplots, var_poutrng

                            '// Call [ATPVBAEN.XLAM].regress()

End Sub


Private Function Array_No_Dims(arr_target()) As Integer

Dim int_dim_num As Integer
Dim errorcheck As Variant

    On Error GoTo FinalDimension
    '//Visual Basic for Applications arrays can have up to 60000 dimensions; this allows for that.
    For int_dim_num = 1 To 60000
        '//It is necessary to do something with the LBound to force it to generate an error.
        errorcheck = LBound(arr_target, int_dim_num)
    Next int_dim_num

Exit Function

'// The error routine.
FinalDimension:

    If int_dim_num - 1 < 1 Then '// array cant have less than 1 dimension, will jump here.
        Array_No_Dims = 1
    Else
        Array_No_Dims = int_dim_num - 1 '// number of dimensions in array
    End If
    
    On Error GoTo 0

End Function

[Pepe Le Mokko]

Welcome to the Forum, unfortunately:

This is a duplicate post and as such does not comply with Rule 5 of our forum rules. This thread will now be closed, you may continue in your other thread.

Thread Closed.