[Solved] Sum unique names of column with thouthands of rows [closed]

by


Try this code below : 

Sub sumTotal()

    'dim array to store unique names
    Dim uniqueArray As Variant

    'Sheets(your chosen sheet)
    With Sheets(1)

        'find last cell with value in A
        Set last = .Range("A:A").Find("*", Cells(1, 1), searchdirection:=xlPrevious)

        'for each cell in column to last value found
        For n = 1 To last.Row
            'if name isnt in array yet
            If Not InArray(.Cells(n, 1).Value, uniqueArray) Then

                'check if array is empty redim/resize array and attribute value
                If IsEmpty(uniqueArray) Then
                    ReDim uniqueArray(0)
                    uniqueArray(0) = .Cells(n, 1).Value
                Else
                    ReDim Preserve uniqueArray(0 To UBound(uniqueArray) + 1)
                    uniqueArray(UBound(uniqueArray)) = .Cells(n, 1).Value
                End If
            End If
        Next

        'for each of the gathered names
        For n = 0 To UBound(uniqueArray)
            'set name in column C
            .Cells(n + 1, 3).Value = uniqueArray(n)
            'set value of application sum if column D
            .Cells(n + 1, 4).Value = Application.WorksheetFunction.SumIf(Range("A:A"), uniqueArray(n), Range("B:B"))
        Next
    End With
End Sub
Function InArray(val As String, arr As Variant) As Boolean

    'set default value of InArray
    InArray = False
    If IsEmpty(arr) Then Exit Function

    'for each name in array
    For n = 0 To UBound(arr)
        'if name is found
        If val = arr(n) Then
            'return true
            InArray = True
            'ext function earlier
            Exit Function
        End If
    Next
End Function

7

solved Sum unique names of column with thouthands of rows [closed]