I am trying to groupby and sum the rows of an Excel file and sum the amount. Sample Data:

Expected Output:

Sub Output_Final_Validation(strval As String)
    
    Dim wrkbokval As Workbook
    Dim shtval As Worksheet
    Dim shterror As Worksheet
    Dim Lastrow As Long
    Dim LastCol As Long
    
    Set wrkbokval = Workbooks.Open(strval)
    Set shtval = wrkbokPRval.Sheets("Sheet4")
    
    Lastrow = shtval.Cells(Rows.Count, 1).End(xlUp).Row
    
    shtval.Range("A2:AP" & Lastrow).Value = shtval.Range("A2:Z" & Lastrow).Value

Please suggest how we can resolve it, I need to groupby on column Name and Age and ̀ Sum NetPayandGross Value`.

CodePudding user response：

The simplest way to do this is using a pivot table. Your reaction on that proposal is "I want to use VBA", so my answer is "Ok, hereby a macro you can use for creating a pivot table using VBA" (I simply added a pivot table and recorded the whole thing :-) ):

Hereby the result (some cleaning might be useful):

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R10C4", Version:=6).CreatePivotTable TableDestination:= _
        "Sheet1!R2C6", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("Sheet1").Select
    Cells(2, 6).Select
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Name")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Age"), "Sum of Age", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("NetPay"), "Sum of NetPay", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Gross Value"), "Sum of Gross Value", xlSum
    ActiveWorkbook.ShowPivotTableFieldList = False
End Sub

CodePudding user response：

You can do it using a Dictionary to store name concatenaded with age (it looks like it's your unique ID, but consider using something else because 2 people can share name AND age easily) and then apply SumIfs to get your calculus:

Sub test()
Dim rngSource As Range
Dim i As Long
Dim Dict As Object
Dim LR As Long
Dim MyStr As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

Set Dict = CreateObject("Scripting.Dictionary")
Set rngSource = Range("A2:D" & LR)


For i = 2 To LR Step 1
    If Dict.Exists(Range("A" & i).Value & "|" & Range("B" & i).Value) = False Then
        Dict.Add Range("A" & i).Value & "|" & Range("B" & i).Value, 0
    End If
Next i

'destination. I'm pasting in cell G2

Range("G2").Resize(Dict.Count, 1) = Application.WorksheetFunction.Transpose(Dict.Keys)

Dict.RemoveAll
Set Dict = Nothing

i = 2
Do Until Range("G" & i).Value = ""
    Range("H" & i).Value = Split(Range("G" & i).Value, "|")(1) 'age
    Range("G" & i).Value = Split(Range("G" & i).Value, "|")(0) 'name
    With Application.WorksheetFunction
        Range("I" & i).Value = .SumIfs(rngSource.Columns(3), rngSource.Columns(1), Range("G" & i).Value, rngSource.Columns(2), Range("H" & i).Value) 'NetPay
        Range("J" & i).Value = .SumIfs(rngSource.Columns(3), rngSource.Columns(1), Range("G" & i).Value, rngSource.Columns(2), Range("H" & i).Value) 'Gross Value
    End With
    i = i   1
Loop

Set rngSource = Nothing

End Sub