Click here to edit title

lets learn together

Download

Autosum

Posted by [email protected] on May 7, 2015 at 11:45 AM

Sub Autosum_generated()

'Dim x As Range

Dim lr As Integer

lr = Range("A65536").End(xlUp).Row

For j = lr To 3 Step -1

If Range("A" & j).Value <> Range("A" & j - 1).Value Then

Range("A" & j).EntireRow.Insert shift:=xlDown

End If

Next

 

Range("D1").Select

ActiveSheet.UsedRange

 

lr1 = Range("D65536").End(xlUp).Row

 

Set tot = Range("D2:D" & lr1)

 

For Each cell In tot

On Error GoTo Handler:

sp = ActiveCell.Row + 1

ActiveCell.End(xlDown).Select

ep = ActiveCell.Row

TR = ep - sp

ActiveCell.Offset(1, 0).Select

x = Range(Cells(sp, 4), Cells(ep, 4)).Address

n = Application.WorksheetFunction.Sum(Range(x).Value)

ActiveCell.Value = n

Next

Handler:

Range("A1").Select

Exit Sub

End Sub

 

 

 

Categories: None

Post a Comment

Oops!

Oops, you forgot something.

Oops!

The words you entered did not match the given text. Please try again.

Already a member? Sign In

0 Comments