At Perconaâ€™s web store you can order your MySQL database support needs in minutes. No hassles, no fuss, just pick and click. Pay online with a credit card.
Become a Premium Member and unlock a new, free course in leading technologies each month.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Sub subFilterUniqueSubtotal()
Dim intColumnSumOffset As Integer
'Enter an offset for column to sum
intColumnSumOffset = 1
Dim rng As Range
Set rng = Selection
If rng.Columns.Count > 1 Then
MsgBox "You have selected more than one column. Aborting", vbOKOnly
Exit Sub
End If
If rng.Rows.Count = 1 Then
MsgBox "Please select your data. Aborting", vbOKOnly
Exit Sub
End If
Dim rngDest As Range
Set rngDest = Cells(rng.Row + rng.Rows.Count + 4, rng.Column)
rngDest.ClearContents
rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngDest, Unique:=True
Range(rngDest.Offset(1, intColumnSumOffset), _
rngDest.End(xlDown).Offset(0, intColumnSumOffset)).Formula = "=SUMPRODUCT((" & rngDest.Offset(1, 0).Address(False, True) & "=" & rng.Offset(1, 0).Address & ")*" & rng.Offset(1, intColumnSumOffset).Address(True, False) & ")"
End Sub
Sub CreateTotals2()
Dim t As Integer
Dim c As Range
Dim col As Integer
Dim cols As Integer
Set c = ActiveSheet.Cells(Cells.Rows.Count, 29).End(xlUp).Offset(1, 0)
col = ActiveSheet.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
For t = 0 To 5
If t = 0 Then
c = "Totals"
For col = 30 To 36
c.Offset(0, col - 1) = "=ROUND(SUM(" & Cells(1, col).Address(False, False) & ":" & c.Offset(-1, col - 1).Address(False, False) & "),2)"
Next col
Else
c.Offset(t, 0) = "Group " & t & " Total"
For col = 30 To 36
c.Offset(t, col - 1) = "=ROUND(SUMIF(AC5:AC" & c.Row - 1 & ",""" & "=" & t & """," & Cells(1, col).Address(False, False) & ":" & c.Offset(-1, col - 1).Address(False, False) & "),2)"
Next col
End If
Next t
End Sub
Book2.xls
Sub subFilterUniqueSubtotal()
Dim intColumnSumOffset As Integer
'Enter an offset for column to sum
intColumnSumOffset = 1
Dim rng As Range
Set rng = Range("AD5:AD22")
Dim rngDest As Range
Set rngDest = Cells(rng.Row + rng.Rows.Count + 2, rng.Column)
rngDest.ClearContents
rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngDest, Unique:=True
for intColumnSumOffset = 1 to 7
Range(rngDest.Offset(1, intColumnSumOffset), _
rngDest.End(xlDown).Offset(0, intColumnSumOffset)).Formula = "=SUMPRODUCT((" & rngDest.Offset(1, 0).Address(False, True) & "=" & rng.Offset(1, 0).Address & ")*" & rng.Offset(1, intColumnSumOffset).Address(True, False) & ")"
next intColumnSumOffset
End Sub
Sub specialmacro()
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
Dim lastrow As Long
Dim i As Long
Dim n As Long
Dim coll As New Collection
With Sheets("Sheet1")
For i = 5 To 1000
If .Cells(i, "B") = "Total" Then
lastrow = i - 1
Exit For
End If
Next i
For i = 1 To 7
.Cells(lastrow + 1, i + 2).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
Next i
Set rng = Range(.Cells(5, "B"), .Cells(lastrow, "B"))
For Each celle In rng
On Error Resume Next
coll.Add CStr(celle), CStr(celle)
Next celle
For i = 1 To coll.Count
.Cells(lastrow + 2 + i, "B") = --coll(i)
Next i
For i = 1 To coll.Count
For n = 3 To 9
.Cells(lastrow + 2 + i, n).FormulaR1C1 = "=SUMIF(R5C2:R22C2,RC2,R5C:R22C)"
Next n
Next i
For n = 3 To 9
.Cells(lastrow + 2 + coll.Count + 1, n).FormulaR1C1 = "=SUM(R[" & -coll.Count & "]C:R[-1]C)"
Next n
End With
End Sub
llawrenceg-01.xls
Sub specialmacro()
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
Dim lastrow As Long
Dim i As Long
Dim n As Long
Dim coll As New Collection
Application.ScreenUpdating = False
With Sheets("Sheet1")
lastrow = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row
.Cells(.Cells.Rows.Count, "B").End(xlUp).Offset(1, 0) = "Total"
.Cells(.Cells.Rows.Count, "B").End(xlUp).Offset(1, 0) = "Group Total"
For i = 1 To 7
.Cells(lastrow + 1, i + 2).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
.Cells(lastrow + 1, i + 2).NumberFormat = "[$$-409]#,##0.00"
Next i
Set rng = Range(.Cells(5, "B"), .Cells(lastrow, "B"))
For Each celle In rng
On Error Resume Next
coll.Add CStr(celle), CStr(celle)
Next celle
For i = 1 To coll.Count
.Cells(lastrow + 2 + i, "B") = --coll(i)
Next i
For i = 1 To coll.Count
For n = 3 To 9
.Cells(lastrow + 2 + i, n).FormulaR1C1 = "=SUMIF(R5C2:R22C2,RC2,R5C:R22C)"
.Cells(lastrow + 2 + i, n).NumberFormat = "[$$-409]#,##0.00"
Next n
Next i
For n = 3 To 9
.Cells(lastrow + 2 + coll.Count + 1, n).FormulaR1C1 = "=SUM(R[" & -coll.Count & "]C:R[-1]C)"
.Cells(lastrow + 2 + coll.Count + 1, n).NumberFormat = "[$$-409]#,##0.00"
Next n
End With
End Sub
llawrenceg-02.xls
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.