SUM on varying number of cells in VBA

[mathmani]

I am writing sum of few cells from the row above, to a single cell and then merging the cells
I need to achieve this in vba but the problem is that the number of columns I need to use in the SUM formula can change month by month, though I know how many columns are there in each month (See attached excel) and I am using A1 style to write formula in my code. I couldn't find any way to write formula in vba in such a way that you can change column name to variable (so that first sum covers C2 - C6, second covers C7 - C10 etc.).
Any help will be highly appreciated.

[HaHoBe]

Hi, mathmani,

sorry but I couldnīt find any code in your sample workbook...

Sub I_Hate_Merged_Cells()

Dim lngLast As Long
Dim rngMerged As Range

lngLast = Cells(Rows.Count, "A").End(xlUp).Row

Range("B1").Select

Do While ActiveCell.Value <> ""
  Set rngMerged = ActiveCell.MergeArea
  If rngMerged.Cells.Count > 0 Then
    Cells(lngLast, rngMerged.Cells(1).Column).Formula = "=SUM(" & Cells(2, rngMerged.Cells(1).Column).Address(0, 0) & ":" & _
        Cells(lngLast - 1, rngMerged.Cells(rngMerged.Cells.Count).Column).Address(0, 0) & ")"
  End If
  ActiveCell.Offset(0, 1).Select
Loop

End Sub

Ciao,
Holger

[mathmani]

Thanks HaHoBe. This has worked perfectly with the example I posted. Now when I am trying to further expand it to use SUMPRODUCT with more conditions added, it's failing (And I think that is because I am trying to mix styles of writing formulas). Would you be able to look at it please ? Attached is the excel with final fomula that I am trying to print and below is theexcerpt of the overall code I have written. The additional formula is highlighted in maroon color which seems to be giving problem -

Do While ActiveCell.Value <> ""
Set rngMerged = ActiveCell.MergeArea
If rngMerged.Cells.Count > 0 Then
Cells(lngLast + 1, rngMerged.Cells(1).Column).Formula = "=SUMPRODUCT(" & Cells(3, rngMerged.Cells(1).Column).Address(0, 0) & ":" & _
Cells(lngLast - 1, rngMerged.Cells(rngMerged.Cells.Count).Column).Address(0, 0) & ")*($A$3:$A$" & n & "=""RP1"")*($C$3:$C$" & n & "=""" & RP(i, 1) & """))"
End If
ActiveCell.Offset(0, 1).Select
Loop
'''' ---- RP(i,1) will contain names (in the excel "Central Team", "BBB", etc.)

[HaHoBe]

Hi, mathmani,

variables n and i are not declared, and Iīm afraid I donīt see how you want these to be combined as only one formula was inserted which doesnīt cover the whole range build in the left 3 columns but is one short on rows.

Ciao,
Holger

[mathmani]

variables i and n are defined at start of the code and when the flow enters above code for first time, value of m and n are 25 and 23 respectively. As I had mentioned above written code was only an extract. I don't want to cover the last row of the data, and the excel which I had uploaded was also a sample. If I can summarise the requirement, I would want to use SUMPRODUCT function for each combination of values in Column A and Column C. This SUMPRODUCT will be used for all weeks under a month and need to be repeated for all months and as you can see number of weeks in a month can change. does it clarify ?

[HaHoBe]

Hi, mathmani,

wouldnīit be a great idea to share all the code you have so far and not only a sniplet which canīt work due to a missing opening bracket (check the formula inserted manually where 2 opening brackets appear against the code) and only one item in a list referred to?

Maybe you can use the approach like this:

Private Sub FindUniqueItems(UniqueItems As Variant, FilterRange As String)
' returns a list containing all unique items in the filter range
' Originally taken from ErlandsenData, modified for ExcelForum
Dim TempList() As String, UniqueCount As Integer, cl As Range, i As Integer
    Range(FilterRange).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    UniqueCount = Range(FilterRange).SpecialCells(xlCellTypeVisible).Count
    ReDim TempList(1 To UniqueCount - 1)
    i = 0
    For Each cl In Range(FilterRange).SpecialCells(xlCellTypeVisible)
        If Len(cl) > 0 Then
          i = i + 1
          If i > 1 Then TempList(i - 1) = cl.Formula ' ignore the heading
        End If
    Next cl
    ReDim Preserve TempList(1 To i - 1)
    Set cl = Nothing
    UniqueItems = TempList
    ActiveSheet.ShowAllData
End Sub

Sub Still_Dont_Like_Merged_Cells()

Dim ItemListA
Dim ItemListC

Dim lngColA As Long
Dim lngColC As Long
Dim lngLastRow As Long
Dim lngRngUsed As Long
Dim lngOffset As Long
Dim rngMerged As Range

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
lngRngUsed = lngLastRow - 1

FindUniqueItems ItemListA, Range("A2:A" & lngRngUsed).Address
FindUniqueItems ItemListC, Range("C2:C" & lngRngUsed).Address
Range("D1").Select

Do While ActiveCell.Value <> ""
  Set rngMerged = ActiveCell.MergeArea
  If rngMerged.Cells.Count > 0 Then
    lngOffset = 1
    For lngColA = LBound(ItemListA) To UBound(ItemListA)
      For lngColC = LBound(ItemListC) To UBound(ItemListC)
        Cells(lngLastRow + lngOffset, rngMerged.Cells(1).Column).Formula = "=SUMPRODUCT((" & Cells(3, rngMerged.Cells(1).Column).Address(0, 0) & ":" & _
            Cells(lngRngUsed, rngMerged.Cells(rngMerged.Cells.Count).Column).Address(0, 0) & ")*($A$3:$A$" & lngRngUsed & "=""" & ItemListA(lngColA) & _
            """)*($C$3:$C$" & lngRngUsed & "=""" & ItemListC(lngColC) & """))"
        lngOffset = lngOffset + 1
      Next lngColC
    Next lngColA
  End If
  ActiveCell.Offset(0, 1).Select
Loop

End Sub

Ciao,
Holger