Snasui Excel Forum

Code: Select all

Option Explicit
Dim grandTotal As Double
Public Function compareprocap()
              ActiveWorkbook.Sheets("MPS TEMPLATE").Activate
                        Dim rAll As Range, r As Range
                        Dim colR As Collection, item As Variant
                        Dim subTotal As Double, target As Range
                        Dim iMax As Integer, iCount As Integer
                        Set colR = New Collection
                        Dim grandTotal As Double
                            grandTotal = 0
                        With Sheets("NEWDATA")
                            Set rAll = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
                        End With
                        On Error Resume Next
                        For Each r In rAll
                            colR.Add r, r 'row number null
                        Next r
                        On Error GoTo 0   'debug error
                        
                        For Each item In colR
                            iMax = Application.CountIf(rAll, item)
                            iCount = 0
                            subTotal = 0
                            For Each r In rAll
                                If r <> "" Then
                                    With Sheets("MPS TEMPLATE")
                                        Set target = .Range("a" & Range("a99999").End(xlUp).Row).Offset(1, 0) 'set target
                                    End With
                                    
                                    If r = item Then
                                        Rows(target.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'insert row
                                        
                                        target.Offset(-1, 0) = r
                                        target.Offset(-1, 0).Offset(0, 1) = r.Offset(0, 1) 'count colum capacit
                                        subTotal = subTotal + r.Offset(0, 1)
                                        iCount = iCount + 1
                                    End If
                                    If iCount = iMax Then
                                        Rows(target.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'insert row
                                        
                                        With Sheets("MPS TEMPLATE").Range("a" & Range("a99999").End(xlUp).Row)
                                            .Offset(1, 0) = "Sub Total"
                                            .Offset(1, 1).Font.Color = -10477568
                                            .Offset(1, 1).Font.Bold = True
                                            grandTotal = grandTotal
                                            subTotal = 0
                                        End With
                                        With Sheets("MPS TEMPLATE")
                                            Range("a" & target.Row - 1 & ":n" & target.Row - 1).Interior.Color = 13434777
                                        End With
                                        Exit For
                                    Else
                                    End If
                                End If
                             Next r
                             grandTotal = grandTotal
                        Next item
                        With Sheets("MPS TEMPLATE").Range("a" & Rows.Count).End(xlUp)
                            .Offset(1, 0) = "Grand Total"
                    
                            .Offset(1, 1).Font.Color = 15773696
                            .Offset(1, 1).Font.Bold = True
                        End With
                        With Sheets("MPS TEMPLATE")
                            Range("a" & target.Row & ":n" & target.Row).Interior.Color = 49407
                        End With
End Function