VBA or Formula to SUM multiple cells into one and delete rows of remaining

[Prasad K]

Hi
Have data with multiple columns with

col-A Cus-Name
col-B InVoice-No
col-C First Bill-Amount
col-D Second Bill-Amount

i have applied this below VBA to Sum and Delete Rows here my problem is it's not giving result has i expect


This is data i have

MMM.xlsm
	A	B	C	D
1	Cus-Name	InVoice-No	First Bill-Amount	Second Bill-Amount
2	Raju.M	BVSI-001	250.75	425.98
3	Raju.M	BVSI-001	450.25	284.65
4	Raju.M	BVSI-001	321.45	674.25
5	Raju.M	BVSI-001	458.32	954.65
6	Swathi.P	BVSI-002	250.75	742.65
7	Swathi.P	BVSI-002	450.25	248.65
8	Swathi.P	BVSI-002	321.45	485.39
9	Swathi.P	BVSI-002	458.32	147.58
Sheet2

i want like this

MMM.xlsm
	A	B	C	D
1	Cus-Name	InVoice-No	First Bill-Amount	Second Bill-Amount
2	Raju.M	BVSI-001	1480.77	2339.53
3	Swathi.P	BVSI-002	1480.77	1624.27
Sheet2

Sub CombineRows()
Dim WorkRng As Range
Dim Dic As Variant
Dim arr As Variant
On Error Resume Next
xTitleId = "Excel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
arr = WorkRng.Value
For i = 1 To UBound(arr, 1)
    Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
Application.ScreenUpdating = False
WorkRng.ClearContents
WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
Application.ScreenUpdating = True
End Sub

 

[Marc L]

Hi, just removing the useless according to Excel basics a VBA demonstration for starters :​

Sub Demo1()
         Dim Rg(1) As Range
         Set Rg(1) = [Sheet2!B1]
         Application.ScreenUpdating = False
    With Rg(1).CurrentRegion.Columns
        While Rg(1).Row < .Rows.Count
            Set Rg(0) = Rg(1)(2)
            Set Rg(1) = .Item(2).Find(Rg(0), , xlValues, 1, , 2)
             If Rg(1).Row > Rg(0).Row Then Rg(0)(1, 2).Resize(, 2).Value2 = Array(Application.SumIf(.Item(2), Rg(0), .Item(3)), _
                                                                                  Application.SumIf(.Item(2), Rg(0), .Item(4)))
        Wend
            .RemoveDuplicates 2, 1
    End With
         Application.ScreenUpdating = True
         Erase Rg
End Sub

 

[Prasad K]

Hi, just removing the useless according to Excel basics a VBA demonstration for starters :​

Sub Demo1()
         Dim Rg(1) As Range
         Set Rg(1) = [Sheet2!B1]
         Application.ScreenUpdating = False
    With Rg(1).CurrentRegion.Columns
        While Rg(1).Row < .Rows.Count
            Set Rg(0) = Rg(1)(2)
            Set Rg(1) = .Item(2).Find(Rg(0), , xlValues, 1, , 2)
             If Rg(1).Row > Rg(0).Row Then Rg(0)(1, 2).Resize(, 2).Value2 = Array(Application.SumIf(.Item(2), Rg(0), .Item(3)), _
                                                                                  Application.SumIf(.Item(2), Rg(0), .Item(4)))
        Wend
            .RemoveDuplicates 2, 1
    End With
         Application.ScreenUpdating = True
         Erase Rg
End Sub

i have getting error of (compile error variable not defined)

 

[Marc L]

​

No compile error on my side as it works a treat so erase the procedure and try again to copy/paste …​

 

[Prasad K]

​

No compile error on my side as it works a treat so erase the procedure and try again to copy/paste …​

Yes Marc L
it's my mistake i have placed code in wrong way

Now it's working perfectly has i expected

Thank you so much for your help