Cumulate items macro

[Andrei]

Hello,

I made a macro that should cumulate the items from a Timesheet Export: for example if the value from cell (2,21) is the same with the value from cell (1,21) then sum the amount from cell (2,12) to cell (1,12) and delete the entire row of cell (2,21).

Untill now my macro does something, but it seems that is not 100%:

Sub macro1()

lastrow = Range("A1").End(xlDown).Row

For i = 1 To lastrow
   
    For n = 1 To lastrow

If Cells(i + n, 21) = Cells(i, 21) Then  'if the values from column 21 are the same then cumulate items

'sum the values from row i+n on row i
Cells(i, 12).Value = Cells(i, 12).Value + Cells(i + n, 12).Value
'put the text from row i+n on row n with ";" separator
Cells(i, 18) = Cells(i, 18) & "; " & Cells(i + n, 18)

'delete row i+n
Cells(i + n, 1).Select
Selection.EntireRow.Delete

End If

    Next n
   
Next i

End Sub

I also attached the file for example.

Can you take a look and explain what i am missing ?

Thanks

 

[Andrei]

The problem is that the loop stops after it finds one same combination and i must run again the macro.. The question is how to do so the loop will continue to next combination without stopping ? (if there are more then 2 same items). And on the lastrow+1 why it writes ";;;;" ?

Thanks

 

[Andrei]

Hello again,

I manage to solve this, so i will post the solution here, maybe someone else will need and use it:

I thought that the problem was that it deleted the rows into the loop, so first we will sum the hour amounts (from duplicate items) at the first item, and at the duplicates will put 0 hours. Then we write the description in the corresponding cell of first item with ";" separator. And after this loop we create another loop for deleting the items with 0 values at the hours column. This is the code and is working good (maybe will need some adjustments to be faster- sort and delete all 0 itemes in the same time etc):

Sub macro1()

Dim i As Integer
Dim n As Integer
Dim x As Integer

lastrow = Range("A1").End(xlDown).Row

For i = 1 To lastrow
   
    For n = 1 To lastrow
   
If Cells(i, 21) = "" Then
Exit For

ElseIf Cells(i + n, 21) = Cells(i, 21) Then  'if the values from column 21 are the same then cumulate items

'sum the values from row i+n on row i
Cells(i, 12).Value = Cells(i, 12).Value + Cells(i + n, 12).Value
Cells(i + n, 12) = 0

'put the text from row i+n on row n with ";" separator
Cells(i, 18) = Cells(i, 18) & "; " & Cells(i + n, 18)

End If

    Next n
   
Next i

'delete row i+n
For x = lastrow To 1 Step -1
   
If Cells(x, 12) = "0" Then

Cells(x, 12).Select
Selection.EntireRow.Delete

End If

Next x

End Sub

 

[SirJB7]

Hi, Andrei!
Thanks for sharing your solution with the community, so as people who read this could have the issue or question and the solution or answer as well.
Regards!