Sudipta,
There isn't a lot of information in your post but it sounds similar to
something I do to analyse information from our core financial system. I hope
this code helps a little.
Basically it sorts the abstracted sheet by a key relevant to me, crawls down
column A ( representing a cost centre code) looking for rows where a change
in value occurs and inserts a blank row at that interface. It then inserts a
subtotal in the blank row (at column "e" in my case)
If there is more than one block a "grand total" is inserted for all the
blocks.
This is just a portion of the overall code and I haven't checked it works in
this standalone fashion - you will need to amend it to suit your
circumstances. I hope it is of some assistance to you. (there is probably a
much better way of doing all this and I have only replied as there have been
no responses so far)
I have code which allows me to perform other sorts on the abstracted blocks
via a custom toolbar, but that is in separate modules not posted here. Let
me know if it would be of help.
(Dimension variables here)
'sort the entire sheet - this is before it is split into blocks
Set rngSortCell = Cells(Sheets(Name).Cells(Rows.Count, "E").End(xlUp).Row,
9)
Worksheets(Name).Range("A4:" & rngSortCell.Address).Sort _
Key1:=Worksheets(Name).Columns("A"), _
Key2:=Worksheets(Name).Columns("G"), _
key3:=Worksheets(Name).Columns("b"), _
Header:=xlNo
'start splitting the sheet into blocks by separating each WBS with a blank
line
Set rngLastCell = Cells(Sheets(Name).Cells(Rows.Count, "e").End(xlUp).Row,
6)
Set startCell = Cells(4, 6)
With Sheets(Name)
strTotal = "="
intBlockCount = 0
Set rngPlaceHolder = Range(rngLastCell.Address).Offset(1, 0)
Set rngTopCell = Cells(4, 6)
intOtherCounter = 0
intStartRow = 4
intCounter = Cells(Sheets(Name).Cells(Rows.Count, "a").End(xlUp).Row, 1).Row
intCellTarget = 4
With Sheets(Name)
Cells(intCellTarget, 1).Select
For i = 4 To intCounter
If Cells(intCellTarget, 1).Value <> Cells(intCellTarget + 1, 1).Value Then
ActiveCell.Offset(1, 0).EntireRow.Insert shift:=xlDown
intBlockCount = intBlockCount + 1
ActiveCell.Offset(1, 0).Select
If Len(ActiveCell.Offset(-1, 0).Value) > 10 Then
strTotal = strTotal & "+" & ActiveCell.Offset(0, 5).Address
End If
'sub-total for each block
ActiveCell.Offset(0, 5).Formula = "=SUM(" & rngTopCell.Address(False, False)
& ":" & ActiveCell.Offset(-1, 5).Address(False, False) & ")"
ActiveCell.Offset(0, 5).Font.Bold = True
intCellTarget = intCellTarget + 1
Set rngTopCell = ActiveCell.Offset(1, 5)
End If
ActiveCell.Offset(1, 0).Select
intCellTarget = intCellTarget + 1
intOtherCounter = intOtherCounter + 1
Next i
End With
'only put a grand total on the sheet if there is more than one block
With Sheets(Name)
rngPlaceHolder.Select
If intBlockCount > 1 Then
ActiveCell.Formula = strTotal
ActiveCell.Offset.Font.Bold = True
ActiveCell.Offset(0, -2) = "GRAND TOTAL"
ActiveCell.Offset(0, -2).Font.Bold = True
End If
ActiveSheet.Columns("A:I").AutoFit
