Subtotals and Weighted Averages

[jslipher]

I have a set of data that I ran Excel's embedded Subtotals function in the Data tab and used the Sum function in column "I" for each change in column "B". I am wanting to do a weighted average of column "L" based on column "I". I found this set of code in the forum that should take of this:

Sub test()

For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("I:I"))
If Left(c.FormulaR1C1, 4) = "=SUB" Then
c.Offset(0, 3).Formula = "=(SUMPRODUCT(" & c.Precedents.Address & "*" & c.Precedents.Offset(0, 3).Address & ")/SUM(" & c.Precedents.Address & "))"
End If
Next


End Sub

Unfortunately instead of returning =SUMPRODUCT(I:I*L:L)/SUM(I:I) it is returning =SUMPRODUCT(I:I,A:A*L:L,D:D)/SUM(I:I,D:D). Does anyone know why it is doing this? Thanks ahead of time!

 

[tweedle]

Just a guess as I'm not an expert on Precedents;
Are your values in I or L by chance references back to Col A?

 

[jslipher]

One other thing to note. The data in column I and column L is a VLOOKUp function, looking up column A. I assume this is why the Precedents VBA function returns column A as well. Is there anyway to bypass this?

 

[jslipher]

Yes, tweedle. Is there a way to bypass that part or not look back to A?

 

[tweedle]

Scrap this

 

[tweedle]

back to 'should work' status (got flustered in testing )

            'c.Offset(0, 3).Formula = "=(SUMPRODUCT(" & c.Precedents.Address & "*" & c.Precedents.Offset(0, 3).Address & ")/SUM(" & c.Precedents.Address & "))"
            
            AddressFromSubT$ = Mid(c.Formula, 13, InStr(1, c.Formula, ")", vbTextCompare) - 13)
            c.Offset(0, 3).Formula = "=(SUMPRODUCT(" & AddressFromSubT$ & "*" & Range(AddressFromSubT$).Offset(0, 3).Address & ")/SUM(" & AddressFromSubT$ & "))"

 

[jslipher]

That works perfect! Thanks so much!!