Adding a row with the previous one if....

[Denys]

Good morning,

I would like to add all cells in a row with the cells of the previous
row, if the cell in column A = the value of the cell in the previous
row in column A...up until Row 5 included

In other words, let's say that A13= Mary, A14= Mary, A15 =Mary, then I
would like that B14=B15+B14, C14=C15+C14, etc until column BK, then
delete row 15.etc...

Then, B13=B14+B13, C13=C14+C13 , etc....and hen delete row 14.

Here's the code so far, but it works only for Column B ...

Sub Test()

Application.EnableEvents = False
Application.ScreenUpdating = False


Dim DerLig As Long, DerCol As Integer
Dim Rg As Range, i As Long, a As Long


With ActiveSheet
DerLig = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set Rg = .Range("A5", .Cells(DerLig, DerCol))
End With
With Rg
.Sort Key1:=.Item(1, 1), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
For i = Rg.Rows.Count To 1 Step -1
If Rg(i, 1) = Rg(i - 1, 1) And i >= 5 Then
a = a + 1
Else
If a > 0 Then
Rg(i-1, 2).Value = (Rg(i, 2)+Rg(i,2))
Rg(i + 1, 1).Resize(a).EntireRow.Delete
a = 0
Else
If a < 1 Then a = 1
Rg(i-1, 2).Value = (Rg(i, 2)+Rg(i,2))
a = 0
End If
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'---------------------------------------

This code was nicely provided me by Denis

Thanks for your time

Denys

 

[Denys]

Found....

thanks to Denis....again

Denys