Weighted/Conditional LINEST VBA (Coefficient/Y-Intercept)

[rylock]

Hey everyone,

I've got two VBA codes that work really well for what I'm doing, mostly:

1. Conditional LINEST function that only finds the x coefficient if the range matches the additional criteria:

Function LinestCond(rY As Range, rX As Range, rCond As Range, vCond As Variant, _
                               Optional bConst As Boolean = True, Optional bStats As Boolean = False)
Dim vY As Variant, vX As Variant
Dim lRowAll As Long, lRow As Long, lRows As Long, j As Long
 
lRows = Application.WorksheetFunction.CountIf(rCond, vCond)
ReDim vY(1 To lRows, 1 To 1)
ReDim vX(1 To lRows, 1 To rX.Columns.Count)
 
For lRowAll = 1 To rY.Rows.Count
    If rCond(lRowAll) = vCond Then
        lRow = lRow + 1
        vY(lRow, 1) = rY(lRowAll)
        For j = 1 To UBound(vX, 2)
            vX(lRow, j) = rX(lRowAll, j)
        Next j
    End If
Next lRowAll
LinestCond = Application.WorksheetFunction.LinEst(vY, vX, bConst, bStats)
End Function

Formula example:

=LinestCond($U$2:$U$56,$P$2:$P$56,$N$2:$N$56,"D")

Where Column U are the y's, Column P are the x's, and Column N is where the cells are denoted with "D"s or "R"s, so it's pulling only the "D"s.

2. Weighted LINEST function that gives the x coefficient more weight based on how high the numbers are in the range:

Public Function LinestWeighted(xRng As Range, yRng As Range, wRng As Range, bInt As Boolean, bStat As Boolean) As Variant
    Dim x As Variant
    Dim y As Variant
    Dim W As Variant
    Dim TotX As Variant
    Dim TotY As Variant
    Dim lngRow As Long
    Dim strDelim As String
    Dim strX As String
    Dim strY As String
    Dim NewSeries As Variant

    x = Application.Transpose(xRng)
    y = Application.Transpose(yRng)
    W = Application.Transpose(wRng)
    strDelim = ","

    If (UBound(x, 1) = UBound(y, 1)) And (UBound(x, 1) = UBound(W, 1)) Then
        For lngRow = 1 To UBound(W)
            strX = strX & Application.WorksheetFunction.Rept(x(lngRow) & strDelim, W(lngRow))
            strY = strY & Application.WorksheetFunction.Rept(y(lngRow) & strDelim, W(lngRow))
        Next lngRow
        TotX = Split(Left$(strX, Len(strX) - 1), strDelim)
        TotY = Split(Left$(strY, Len(strY) - 1), strDelim)
        ReDim NewSeries(1 To UBound(TotX) + 1, 1 To 2)
        For lngRow = 0 To UBound(TotX)
            NewSeries(lngRow + 1, 1) = CDbl(TotX(lngRow))
            NewSeries(lngRow + 1, 2) = CDbl(TotY(lngRow))
        Next
        With Application
            LinestWeighted = .WorksheetFunction.LinEst(.Index(.Transpose(NewSeries), 2), .Index(.Transpose(NewSeries), 1), bInt, bStat)
        End With
    Else
        LinestWeighted = "input ranges must be equal in length"
        Exit Function
    End If
End Function

Formula example:

=LinestWeighted($P$2:$P$56,$U$2:$U$56,$K$2:$K$56,TRUE,TRUE)

Where Column P are the x's, Column U are the y's, and Column K is where the cells are weighted from 1-38 so the function knows how much weight to give to each point.

Again, these both work great -- but I was wondering if somebody more skilled in VBA than I am could help me do two things:

1. Come up with a VBA code that combines the two (a weighted *and* conditional) LINEST function; and
2. If somebody can help me use these functions to get the y-intercept and not just the x coefficient.

I would be forever grateful! Thanks a lot.

-Ryan

 

[brendanec]

This is an excellent macro to what I have been looking for, so thanks! I don't know how to solve your question (or even how your original VBA works), but I was curious if it was possible to add another condition to the macro? I have 2 (maybe 3) columns that need conditions.