Sumif - Non Contiguous Columns - Syntax please

[u473]

Simplified Sample below :
Criteria in A2 thru A4
Columns to be summed B, C, F in Rows 2 to 4. Data Rows 8 to 13

Col A Col B Col C Col F
A 6 9 10
B 10 2
C 7 12 3
-------------------------------------
Total 23 23 13
-------------------------------------
A 2 4 6
A 5
A 4 4
B 10 2
C 4 3
C 7 8

Found few articles on this subject or in my Bibles.
How do I smartly build my For Each's
and generate my Total Row ?
Help Appreciated,
Wayne,

 

[Guest]

Try using this in B2 and copy across the range you want e.g. B2:C4 and F2:F4

=SUMPRODUCT(($A8:$A13=$A2)*(B8:B13))

Kewa

 

[u473]

Thank you for your suggestion,
but I know already how to resolve the above with Excel,

I want to resolve it with VBA, the solution is partially in this
earlier code
from Tom Ogilvy.

Sumif Non Contig
Sub tester1()
Dim myrow As Integer, mycolumn As Integer
Dim rw As Long, col As Long
Dim rw1 As Long, col1 As Long
myrow = 4
mycolumn = 10
rw = 51
col = 3
For rw1 = 1 To myrow
For col1 = 1 To mycolumn
Cells(rw + rw1, col + col1).Formula = _
"=SUMIF(C5:C49,C" & _
rw + rw1 & "," & _
Range(Cells(5, col + col1), _
Cells(49, col + col1)) _
.Address(False, False) & ")"
Next col1
Next rw1
End Sub

....but I do not know how to integrate and address a range of non
contiguous columns.

 

[Mike Fogleman]

This will work for your example and assumes you already have Sum formulas in
your Total row.

Sub TotalIf()
Dim TblRng As String 'for SUMIF formula
Dim CritRng As String 'for SUMIF formula
Dim SumRng As String 'for SUMIF formula
Dim MyRng As Range 'where formula goes
Dim FrmlRow As Long 'row for formula
Dim FrmlCol As Integer 'column for formula

TblRng = "$A$8:$F$13" 'where data is
FrmlRow = 2 'first formula row
FrmlCol = 2 'first formula column

For FrmlCol = 2 To 6
If FrmlCol = 4 Then FrmlCol = 6 'skips col 4 & 5
CritRng = Range("A" & FrmlRow).Address
SumRng = Range(Cells(8, FrmlCol), Cells(13, FrmlCol)).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
FrmlRow = FrmlRow + 1 'go to next row
For FrmlRow = 3 To 4
CritRng = Range("A" & FrmlRow).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
Next
FrmlRow = 2 'go back to first row
Next
End Sub

Mike F

 

[Mike Fogleman]

Use this modification to create your Total row:

Sub TotalIf()
Dim TblRng As String 'for SUMIF formula
Dim CritRng As String 'for SUMIF formula
Dim SumRng As String 'for SUMIF formula
Dim MyRng As Range 'where formula goes
Dim FrmlRow As Long 'row for formula
Dim FrmlCol As Integer 'column for formula

TblRng = "$A$8:$F$13" 'where data is
FrmlRow = 2 'first formula row
FrmlCol = 2 'first formula column

For FrmlCol = 2 To 6
If FrmlCol = 4 Then FrmlCol = 6 'skips col 4 & 5
CritRng = Range("A" & FrmlRow).Address
SumRng = Range(Cells(8, FrmlCol), Cells(13, FrmlCol)).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
FrmlRow = FrmlRow + 1 'go to next row
For FrmlRow = 3 To 4
CritRng = Range("A" & FrmlRow).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
If FrmlRow = 4 Then
Set MyRng = Cells(FrmlRow + 2, FrmlCol)
SumRng = Range(Cells(2, FrmlCol), Cells(FrmlRow,
FrmlCol)).Address
MyRng.Formula = "=Sum(" & SumRng & ")"
End If
Next
FrmlRow = 2 'go back to first row
Next
End Sub


Mike F

 

[Mike Fogleman]

This will put totals in row 6 and column G:

Sub TotalIf()
Dim TblRng As String 'for SUMIF formula
Dim CritRng As String 'for SUMIF formula
Dim SumRng As String 'for SUMIF formula
Dim MyRng As Range 'where formula goes
Dim FrmlRow As Long 'row for formula
Dim FrmlCol As Integer 'column for formula

TblRng = "$A$8:$F$13" 'where data is
FrmlRow = 2 'first formula row
FrmlCol = 2 'first formula column

For FrmlCol = 2 To 6
If FrmlCol = 4 Then FrmlCol = 6 'skips col 4 & 5
CritRng = Range("A" & FrmlRow).Address
SumRng = Range(Cells(8, FrmlCol), Cells(13, FrmlCol)).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
If FrmlCol = 6 Then
Set MyRng = Cells(FrmlRow, FrmlCol + 1)
SumRng = Range(Cells(FrmlRow, 2), Cells(FrmlRow, 3)).Address
SumRng = Range(SumRng & "," & (Cells(FrmlRow,
6).Address)).Address
SumRng = Replace(SumRng, "$", "")
MyRng.Formula = "=SUM(" & SumRng & ")"
Range(MyRng.Address, MyRng.Offset(2, 0).Address).FillDown
SumRng = Range(Cells(8, FrmlCol), Cells(13,
FrmlCol)).Address
End If
FrmlRow = FrmlRow + 1 'go to next row
For FrmlRow = 3 To 4
CritRng = Range("A" & FrmlRow).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
If FrmlRow = 4 Then
Set MyRng = Cells(FrmlRow + 2, FrmlCol)
SumRng = Range(Cells(2, FrmlCol), Cells(FrmlRow,
FrmlCol)).Address
MyRng.Formula = "=Sum(" & SumRng & ")"
End If
Next
FrmlRow = 2 'go back to first row
Next
End Sub


Mike F

 

[u473]

The above worked perfect, Thank you.
Pussing the issue further, and upstream of this module, how would I
assuming that the data to be summed is in row 2 to 7 (instead of 8 to
13)
1. Populate an array with a list of unique codes from the above
2. Insert the number of summary rows and the blank total row
3. Populate the criteria column with the list of unique codes
before running TotalIf

 

[Mike Fogleman]

Before we start that, what is in columns D & E that separates column F from
the rest? Other numbers, text, blank space?

Mike F

 

[Mike Fogleman]

Also need to know if there are column headers in row 1. If so, then we can
use Advanced Filter to get the unique codes and save them to some out of the
way place on the sheet. By doing a Rows.Count on the unique list we can
calculate how many rows to insert above the data and move the unique list to
the new rows in column A.

Mike F

 

[u473]

1. Yes, Row # 1 is the header Row.
2. Column D is Text for Type of Charge, Column E is Text for Forecast
Variance Justification Comments.
Thank you for your help, this is a real education. I wish I could find
the above in textbooks.
Wayne

 

[Mike Fogleman]

Pushing the issue further, and upstream of this module, how would I
assuming that the data to be summed is in row 2 to 7 (instead of 8 to
13)
1. Populate an array with a list of unique codes from the above
2. Insert the number of summary rows and the blank total row
3. Populate the criteria column with the list of unique codes
before running TotalIf

Data starts in row 2, for any length of rows and is pushed down to
accommodate any number of unique criteria.

Sub TotalIf()
Dim TblRng As String 'for SUMIF formula
Dim CritRng As String 'for SUMIF formula
Dim SumRng As String 'for SUMIF formula
Dim MyRng As Range 'where formula goes
Dim FrmlRow As Long 'row for formula
Dim FrmlCol As Integer 'column for formula
Dim LastRow As Long, LastCol As Long 'for unique list
Dim TblFRow As Long, TblLRow As Long 'define table

'Make unique list and move data down
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, LastCol + 1), Unique:=True
LastRow = Cells(Rows.Count, LastCol + 1).End(xlUp).Row
Range("A2", Cells(LastRow + 3, LastCol)).Insert Shift:=xlDown
Range(Cells(1, LastCol + 1), Cells(LastRow, LastCol + 1)).Cut Range("A1")
Cells(LastRow + 2, 1).Value = "Totals"
With Range(Cells(LastRow + 2, 1), Cells(LastRow + 2, LastCol + 1))
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With

TblFRow = LastRow + 4
TblLRow = Cells(Rows.Count, "A").End(xlUp).Row
TblRng = Range(Cells(TblFRow, 1), Cells(TblLRow, LastCol)).Address 'where
data is
FrmlRow = 2 'first formula row
FrmlCol = 2 'first formula column

For FrmlCol = 2 To LastCol
If FrmlCol = 4 Then FrmlCol = LastCol 'skips col 4 & 5
CritRng = Range("A" & FrmlRow).Address
SumRng = Range(Cells(TblFRow, FrmlCol), Cells(TblLRow,
FrmlCol)).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
If FrmlCol = LastCol Then
Set MyRng = Cells(FrmlRow, FrmlCol + 1)
SumRng = Range(Cells(FrmlRow, 2), Cells(FrmlRow, 3)).Address
SumRng = Range(SumRng & "," & (Cells(FrmlRow,
6).Address)).Address
SumRng = Replace(SumRng, "$", "")
MyRng.Formula = "=SUM(" & SumRng & ")"
Range(MyRng.Address, MyRng.Offset(LastRow - 2,
0).Address).FillDown
SumRng = Range(Cells(TblFRow, FrmlCol), Cells(TblLRow,
FrmlCol)).Address
End If
FrmlRow = FrmlRow + 1 'go to next row
For FrmlRow = 3 To LastRow
CritRng = Range("A" & FrmlRow).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
If FrmlRow = LastRow Then
Set MyRng = Cells(FrmlRow + 2, FrmlCol)
SumRng = Range(Cells(2, FrmlCol), Cells(FrmlRow,
FrmlCol)).Address
MyRng.Formula = "=Sum(" & SumRng & ")"
End If
Next
FrmlRow = 2 'go back to first row
Next
End Sub

Run this code line by line and study what each line does as you watch the
worksheet. There is a lot to learn in how this code works.
Mike F