VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IntegraSortAndGroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Enabled         As Integer
Private Recursions      As Integer
Private SortField()     As String
Private SortOrder()     As Integer
Private SortGroup()     As Integer
Private GroupField()    As String
Private GroupFunction() As String
Private GroupFncField() As Variant
Private GroupPBreak()   As Integer
Private GroupTop        As Integer
   
Sub NewGrp()
    Recursions = -1
    Enabled = False
End Sub
    
Sub AddGrp( _
    SFd As String, _
    SOrd As Integer, _
    SGrp As Integer, _
    GFd As String, _
    GFnc As String, _
    GFncFd As Variant, _
    GPB As Integer, _
    GTop As Integer _
    )
    Recursions = Recursions + 1
    
    ReDim Preserve SortField(Recursions) As String
    ReDim Preserve SortOrder(Recursions) As Integer
    ReDim Preserve SortGroup(Recursions) As Integer
    ReDim Preserve GroupField(Recursions) As String
    ReDim Preserve GroupFunction(Recursions) As String
    ReDim Preserve GroupFncField(Recursions) As Variant
    ReDim Preserve GroupPBreak(Recursions) As Integer
    
    SortField(Recursions) = SFd
    SortOrder(Recursions) = SOrd
    SortGroup(Recursions) = SGrp
    GroupField(Recursions) = GFd
    GroupFunction(Recursions) = GFnc
    GroupFncField(Recursions) = GFncFd
    GroupPBreak(Recursions) = GPB
    
    GroupTop = GTop
    
    Enabled = True
End Sub
    
Function Execute(ClrGrp As Integer) As Integer
    If Not Enabled Then
        Exit Function
    End If
    
    Dim col1 As Variant
    Dim col2 As Variant
    Dim col3 As Variant
    Dim ord1 As Integer
    Dim ord2 As Integer
    Dim ord3 As Integer
    Dim head As Integer
    
    Dim grpfn    As Long
    Dim pb       As Integer
    Dim summ     As Integer
    Dim colnum   As Integer
    Dim grpfd    As Variant
    Dim grpcol() As Integer
    Dim fd       As Integer
    Dim x        As Integer
    Dim c        As Integer
    Dim fstrow   As Integer
    Dim lstrow   As Integer
    Dim fstcol   As Integer
    Dim lstcol   As Integer
    Dim rangeobj As Variant
    
    If ClrGrp Then
        Cells.Select
      
        Selection.RemoveSubtotal
    
        Cells.Select
        Cells.EntireColumn.AutoFit
    
        On Error Resume Next
        
        ActiveWorkbook.Names("_DATABLOCK").Delete
        
        Set rangeobj = ActiveSheet.Range("_COLUMNHEADER")
                
        Range("A" & (rangeobj.row + 1)).Select
        
        fstrow = rangeobj.row
        fstcol = rangeobj.Column
        
        Set rangeobj = ActiveSheet.Range("_COLUMNFOOTER")
                
        lstrow = rangeobj.row - 1
        lstcol = rangeobj.Columns.Count - rangeobj.Column + 1
                
        Set rangeobj = ActiveSheet.Range( _
            ActiveSheet.Cells(fstrow, fstcol), _
            ActiveSheet.Cells(lstrow, lstcol))
            
        rangeobj.Name = "_DATABLOCK"
    End If
 
    ' Sorting
    head = 1 'xlYes
        
    Set col1 = Nothing
    Set col2 = Nothing
    Set col3 = Nothing
        
    If Not Trim(SortField(0)) = "" Then
        Set col1 = ActiveSheet.Range(SortField(0))
        
        If SortOrder(0) = False Then
            ord1 = 2 'Descending
        Else
            ord1 = 1 'Ascending
        End If
    End If
        
    If UBound(SortField) > 0 Then
        If Not Trim(SortField(1)) = "" Then
            Set col2 = ActiveSheet.Range(SortField(1))
            
            If SortOrder(1) = False Then
                ord2 = 2 'Descending
            Else
                ord2 = 1 'Ascending
            End If
        End If
    End If
        
    If UBound(SortField) > 1 Then
        If Not Trim(SortField(2)) = "" Then
            Set col3 = ActiveSheet.Range(SortField(2))
            
            If SortOrder(2) = False Then
                ord3 = 2 'Descending
            Else
                ord3 = 1 'Ascending
            End If
        End If
    End If
        
    If col3 Is Nothing Then
        If col2 Is Nothing Then
            If Not col1 Is Nothing Then
                Call ActiveSheet.Range("_DATABLOCK").Sort(col1, ord1, , , , , , head)
            End If
        Else
            Call ActiveSheet.Range("_DATABLOCK").Sort(col1, ord1, col2, , ord2, , , head)
        End If
    Else
        Call ActiveSheet.Range("_DATABLOCK").Sort(col1, ord1, col2, , ord2, col3, ord3, head)
    End If
        
    ' Grouping
    If GroupTop Then
        summ = 0  'xlSummaryAbove
    Else
        summ = 1  'xlSummaryBelow
    End If
        
    For x = 0 To UBound(SortGroup)
        If SortGroup(x) = True Then
            Select Case GroupFunction(x)
            Case "Average": grpfn = -4106   'xlAverage
            Case "Count": grpfn = -4112     'xlCount
            Case "CountNums": grpfn = -4113 'xlCountNums
            Case "Max": grpfn = -4136       'xlMax
            Case "Min": grpfn = -4139       'xlMin
            Case "Product": grpfn = -4149   'xlProduct
            Case "StDev": grpfn = -4155     'xlStDev
            Case "StDevP": grpfn = -4156    'xlStDevP
            Case "Sum": grpfn = -4157       'xlSum
            Case "Var": grpfn = -4164       'xlVar
            Case "VarP": grpfn = -4165      'xlVarP
            End Select
            
            If GroupPBreak(x) Then
                pb = True
            Else
                pb = False
            End If
            
            grpfd = GroupFncField(x)
            
            ReDim grpcol(UBound(grpfd)) As Integer
            
            For fd = 0 To UBound(grpfd)
                grpcol(fd) = ActiveSheet.Range(grpfd(fd)).Column
            Next
           
            colnum = ActiveSheet.Range(GroupField(x)).Column
                
            With ActiveSheet.Range("_DATABLOCK")
                For c = 1 To .Columns.Count
                    If .Cells(1, c).Value = "" Then
                        .Cells(1, c).Value = "_UNTITLED_"
                    End If
                Next
                
                Call .Subtotal(colnum, grpfn, grpcol, False, pb, summ)
            
                For c = 1 To .Columns.Count
                    If .Cells(1, c).Value = "_UNTITLED_" Then
                        .Cells(1, c).Value = ""
                    End If
                Next
                
                fstrow = .Rows(1).row
                lstrow = .Rows.Count + fstrow - 1
                lstrow = lstrow + 2
                
                fstcol = .Columns(1).Column
                lstcol = .Columns.Count + fstcol - 1
            End With
            
            ActiveWorkbook.Names("_DATABLOCK").Delete
            
            Set rangeobj = ActiveSheet.Range( _
                ActiveSheet.Cells(fstrow, fstcol), _
                ActiveSheet.Cells(lstrow, lstcol))
            
            rangeobj.Name = "_DATABLOCK"
        End If
    Next
    
    If SortGroup(0) = True Then
        Cells.Select
        Cells.EntireColumn.AutoFit
        ActiveSheet.Outline.ShowLevels RowLevels:=2
    End If
    
    If Not Trim(SortField(0)) = "" Then
        fstrow = ActiveSheet.Range("_DATABLOCK").row + 1
        
        ActiveSheet.Range(SortField(0)).Cells(fstrow, 1).Select
    Else
        ActiveSheet.Range("_DATABLOCK").Cells(2, 1).Select
    End If
End Function
