sumif with dynamic column and range in VBA

Question

I want to using sumifs function in VBA. And result paste in same column as previous data.

Answer 1

Twice a SUMIF with Overwrite

• Workbook Download (Dropbox)
• Couldn't find any indication of SUMIFS, so I did it as if there is twice a SUMIF:
  For Columns A and C, and for Columns B and D.

Option Explicit

Sub SumUnique(UniqueFirstCell As Range, ValueFirstCell As Range)

    Dim rng As Range      ' Unique Last Used Cell
    Dim dict As Object    ' Dictionary
    Dim key As Variant    ' Dictionary Key Counter (For Each Control Variable)
    Dim vntU As Variant   ' Unique Range Array
    Dim vntV As Variant   ' Value Range Array
    Dim vntUT As Variant  ' Unique Array
    Dim vntVT As Variant  ' Value Array
    Dim curV As Variant   ' Current Value
    Dim NorS As Long      ' Source Number of Rows
    Dim NorT As Long      ' Target Number of Rows
    Dim i As Long         ' Source/Target Row Counter

    ' Copy Unique Range to Unique Range Array.
    With UniqueFirstCell
        Set rng = .Worksheet.Columns(.Column) _
                .Find("*", , xlFormulas, , , xlPrevious)
        Set rng = .Resize(rng.Row - .Row + 1)
    End With
    vntU = rng

    ' Copy Value Range to Value Range Array.
    With ValueFirstCell
        Set rng = .Worksheet.Columns(.Column) _
                .Find("*", , xlFormulas, , , xlPrevious)
        Set rng = .Resize(rng.Row - .Row + 1)
    End With
    vntV = rng

    ' Create Unique Values and SumIf Values in Dictionary.
    Set dict = CreateObject("Scripting.Dictionary")
    NorS = UBound(vntU)
    For i = 1 To NorS
        curV = vntU(i, 1)
        If curV <> "" Then
            dict(curV) = dict(curV) + vntV(i, 1)
        End If
    Next
    NorT = dict.Count

    ' Resize Unique and Value Arrays to Target Number of Rows.
    ReDim vntUT(1 To NorT, 1 To 1)
    ReDim vntVT(1 To NorT, 1 To 1)

    i = 0
    For Each key In dict.keys
        i = i + 1
        ' Write Dictionary Keys to Unique Array.
        vntUT(i, 1) = key
        ' Write Dictionary Values to Value Array.
        vntVT(i, 1) = dict(key)
    Next

    ' Copy Unique Array to Target Unique Range.
    With UniqueFirstCell
        Set rng = .Resize(.Worksheet.Rows.Count - .Row + 1)
        rng.ClearContents
        Set rng = .Resize(NorT)
    End With
    rng = vntUT

    ' Copy Value Array to Target Value Range.
    With ValueFirstCell
        Set rng = .Resize(.Worksheet.Rows.Count - .Row + 1)
        rng.ClearContents
        Set rng = .Resize(NorT)
    End With
    rng = vntVT

End Sub

Sub Uni()
    Uni1
    Uni2
End Sub

Sub Uni1()
    Const cUni As String = "A2"
    Const cVal As String = "C2"

    With ThisWorkbook.Worksheets("Sheet1")
        SumUnique .Range(cUni), .Range(cVal)
    End With

End Sub

Sub Uni2()
    Const cUni As String = "B2"
    Const cVal As String = "D2"

    With ThisWorkbook.Worksheets("Sheet1")
        SumUnique .Range(cUni), .Range(cVal)
    End With

End Sub

I created two command buttons and put the following code into the sheet module:

Option Explicit

Private Sub cmdRevert_Click()
    [A2:D31] = [J2:M31].Value
End Sub

Private Sub cmdUnique_Click()
    Uni
End Sub