How add the rows with the same value in a col

Closed
tugbakj - Oct 13, 2010 at 12:32 PM
 tugbakj - Oct 14, 2010 at 07:10 AM
Hi Friends,

I'm trying to make a macro to have a summary worksheet.
- My purpose is to add the data in the rows which has the same ID number in the first column.
- In one of my worksheet (temporary worksheet, after obtaining the summary sheet my main macro deletes this tempo worksheet) the data has 5 columns.
First column is ID Numbers; second one is ID Names; third, forth and fifth ones discrete numbers for different .
- So my macro needs to add up the values in the column 3,4,and 5 which has the same ID Name.
For Example if the data is as below
Col1-Col2-Col3-Col4-Col5
11 AAA 10 0 20
12 BBB 2 12 0
13 CCC 4 5 9
11 AAA 5 7 10

the summary sheet should be

Col1-Col2-Col3-Col4-Col5
11 AAA 15 7 30
12 BBB 2 12 0
13 CCC 4 5 9

- I cannot use the pivot table because I want it automated and no interaction should be necessary when new data (into rows) added or refreshened. So I really need the code.
I've got this code below but it does not search and combine the rows if data rows added at the end or if there are empty rows between the data rows.

Thank you for your help, cannot wait how to solve this. :)

Dim rInput As Range
Dim oDic As Object
Dim nTotal(), vInput()
Dim i As Long, j As Long, k As Long

With Application
.ScreenUpdating = False
Sheets("NotINuse3").Activate
Set rInput = Range("A1", Range("E65536").End(xlUp))

vInput = rInput.Value
ReDim nTotal(1 To UBound(vInput, 1), 1 To 5)

Set oDic = CreateObject("Scripting.Dictionary")
With oDic
For i = 1 To UBound(vInput, 1)
If Not .Exists(vInput(i, 1)) Then
j = j + 1
For k = 1 To 5
nTotal(j, k) = vInput(i, k)
Next k
.Add vInput(i, 1), j
ElseIf .Exists(vInput(i, 1)) Then
For k = 2 To 5 'Start it from K=3 because we don't want to add up the machine numbers
nTotal(.Item(vInput(i, 1)), k) = nTotal(.Item(vInput(i, 1)), k) + vInput(i, k)
Next k
End If
Next i
End With


Columns("A:F").Clear
Range("A1").Resize(j, 5) = nTotal

Application.ScreenUpdating = True
End With

2 replies

venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
808
Oct 14, 2010 at 07:00 AM
the first sheet is called "sheet1"
the second sheet is called "summary"

copy all the macros/function in the standard module

BUT RUN ONLY "A_overall_macro"

prefix A is given so that this macro will be first in the list.
the macros are dynamic that is you can have as many rows or columns.

TRY THIS ON YOUR TRUNCATED DATA AS GIVEN IN THE POST.

Dim r As Range, r1 As Range, c1 As Range, x As String, s As Double
Dim j As Long, k As Long
Dim m As Long, n As Long, rfilt As Range, ssum As Double


Sub idname()
With Worksheets("sheet1")
Set r = Range(.Range("A1"), .Range("A1").End(xlDown).Offset(0, 1))
r.AdvancedFilter action:=xlFilterCopy, copytorange:=Worksheets("summary").Range("A1"), _
    unique:=True
 End With
End Sub



Function Sum_Visible_Cells(Cells_To_Sum As Object)
 'reference https://support.microsoft.com/en-us/help/150363
 Dim cell As Range, total As Double
       Application.Volatile
       For Each cell In Cells_To_Sum
           If cell.Rows.Hidden = False Then
               If cell.Columns.Hidden = False Then
                   total = total + cell.Value
               End If
           End If
       Next
       Sum_Visible_Cells = total
 End Function



Sub summingup()
         With Worksheets("sheet1")
j = .Range("A1").End(xlToRight).Column
m = Worksheets("summary").Range("A1").End(xlDown).Row
For k = 3 To j
For n = 2 To m
    With Worksheets("summary")
'msgbox Cells(n, 2).Address
x = .Cells(n, 2)
'msgbox x
  End With
Set r = .Range("A1").CurrentRegion
'msgbox r.Address
r.Cells.AutoFilter field:=2, Criteria1:=x
ssum = Sum_Visible_Cells(Range(.Cells(2, k), .Cells(2, k).End(xlDown)))
'msgbox ssum
    With Worksheets("summary")
.Cells(n, k) = ssum
    End With
r.AutoFilter
Next n
Next k
End With
End Sub



Sub A_overall_macro()
 Worksheets("summary").Cells.Clear
idname
summingup
End Sub



post your comments
0
Thank you so much I am working on it , I think it will be a winner.

Thanks a lot really!

T.J.
0