Make Your Microsoft Dynamics Investment Count & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.
Sub AddSubs2()
Dim LM As Long, i As Long
LM = Range("D" & Rows.Count).End(xlUp).Row
For i = 1 To LM
If Value = "Retail" Then
Worksheets("To Open in '13").Activate
Selection.Subtotal GroupBy:=6, Function:=xlAverage, TotalList:=Array(11, _
12, 13, 16, 17), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Else
Worksheets("To Open in '13").Activate
Selection.Subtotal GroupBy:=5, Function:=xlAverage, TotalList:=Array(11, _
12, 13, 16, 17), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End If
Next i
End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Option Explicit
Sub AddSubtotals()
Dim WKS As Worksheet
Dim rData As Range
Dim iLastRow As Long
Dim iRow As Long
Dim bTEST As Boolean
Set WKS = ActiveSheet 'set as desired
iLastRow = WKS.Cells(WKS.Rows.Count, "E").End(xlUp).Row
Set rData = WKS.Range("A14:R" & iLastRow)
Call SubtotalRange(rData, , , , , , , True)
Call RangeSort(rData, 4, 5)
Call SubtotalRange(rData, 5, xlAverage, 11, True, False, True, False)
Call SubtotalRange(rData, 4, xlAverage, 11, False, False, False, False)
For iRow = 1 To rData.Rows.Count
If rData(iRow, 4).Value Like "* Average" And rData(iRow, 11).Formula Like "=SUBTOTAL(*" And rData(iRow, 4).Value <> "Retail Average" Then
rData(iRow, 1).EntireRow.Hidden = True
End If
Next iRow
End Sub
Sub RangeSort(ByVal SortRange As Range, _
ParamArray ColumnToSort() As Variant)
Dim WKS As Worksheet
Dim iArrayStep As Long
If IsEmpty(ColumnToSort) Then Exit Sub
Set WKS = SortRange.Parent
WKS.Sort.SortFields.Clear
For iArrayStep = LBound(ColumnToSort) To UBound(ColumnToSort)
WKS.Sort.SortFields.Add Key:=Intersect(SortRange, SortRange(1, ColumnToSort(iArrayStep)).EntireColumn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Next iArrayStep
WKS.Sort.SetRange SortRange
WKS.Sort.Header = xlYes
WKS.Sort.MatchCase = False
WKS.Sort.Orientation = xlTopToBottom
WKS.Sort.SortMethod = xlPinYin
WKS.Sort.Apply
End Sub
Sub SubtotalRange(ByVal rngData As Range, _
Optional ByVal ColumnToGroupBy As Long, _
Optional ByVal FunctionToUse As Variant, _
Optional ByVal ColumnToSubtotal As Long, _
Optional ByVal ReplaceSubtotals As Boolean, _
Optional ByVal AddPageBreaks As Boolean = False, _
Optional ByVal SummarizeBelow As Boolean = True, _
Optional ByVal RemoveSubtotals As Boolean = False)
On Error Resume Next
If RemoveSubtotals Then
rngData.RemoveSubtotal
Else
rngData.Subtotal GroupBy:=ColumnToGroupBy, Function:=FunctionToUse, TotalList:=Array(ColumnToSubtotal), Replace:=ReplaceSubtotals, PageBreaks:=AddPageBreaks, SummaryBelowData:=SummarizeBelow
End If
On Error GoTo 0
End Sub
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Why would a IF THEN result jump up to a prior line in the VBA code | 12 | 51 | |
If condition and Date Ranges | 13 | 51 | |
Excel macro to autofill data in column based on adjoining column and continue for each value in column | 3 | 29 | |
Excel Data Validation Help | 9 | 49 |
Join the community of 500,000 technology professionals and ask your questions.