automatic update in other sheets: need some changes to the existing code

[aravindhan_31]

Hi,

I have already got an anwer for this long back from this site. The code was writted by Mr. Krishnakumar
the thread is here : http://www.mrexcel.com/forum/showthread.php?t=236699


i need some changes to be made in this code. The existing code creates and updates the details in the sheets automatically from the master data. I just need the sum of Column I in all the sheets after the last row of Column I.

selecting all the sheets and typing the formula in I column is not possible because, the last row in Column I is different in all the sheets.
In sheet 1, the last row of Column I is Row 15, in sheet 2 Row150 is the last row.
I guess something could be done in macros.

follwing is the existing code:

 Sub TestIt()
Dim sWS     As Worksheet
Dim Sellers As Range, Seller    As Range
Dim lRow    As Long, fRow       As Integer
Dim CopyRng As Range, ws        As Worksheet

Set sWS = Worksheets("Data")
lRow = sWS.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    sWS.Columns(1).Insert
    sWS.Range("B1:B" & lRow).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=sWS.Range("A1"), Unique:=True
fRow = sWS.Range("A" & Rows.Count).End(xlUp).Row
Set Sellers = sWS.Range("A2:A" & fRow)
    For Each Seller In Sellers
        With sWS.Range("B1:B" & lRow)
            .AutoFilter Field:=1, Criteria1:=Seller
            Set CopyRng = .Offset(0, 0).Resize(.Rows.Count, Columns.Count - 1). _
                SpecialCells(xlCellTypeVisible)
            On Error Resume Next
            Set ws = Sheets(Seller.Value)
            On Error GoTo 0
            If Not ws Is Nothing Then
                CopyRng.Copy
                ws.Range("A1").PasteSpecial xlPasteValues
            Else
                Set ws = Sheets.Add
                ws.Name = Seller.Value
                CopyRng.Copy
                ws.Range("A1").PasteSpecial xlPasteValues
            End If
            .AutoFilter
        End With
        Set ws = Nothing
        Set CopyRng = Nothing
    Next Seller
    sWS.Columns(1).Delete
    Application.ScreenUpdating = True
End Sub

 

[DonkeyOte]

ws.Cells(Rows.Count,9).End(xlUp).Offset(1,0).Formula = "=SUM(R1C:R[-1]C)"

 

[Krishnakumar]

Hi,

In the last row of Col I in Data sheet,

=SUBTOTAL(9,I2:I500)

Replace the 500 with actual last row number.

change the following line

Set CopyRng = .Offset(0, 0).Resize(.Rows.Count, Columns.Count - 1). _
                SpecialCells(xlCellTypeVisible)

with

Set CopyRng = .Offset(0, 0).Resize(.Rows.Count+1, Columns.Count - 1). _
                SpecialCells(xlCellTypeVisible)

HTH

 

[aravindhan_31]

Hi Krish & lasw,

Perfect, I got the result. a quick question again, can we make the total in Bold automatically? by the code? coz i got about 125 sheets.

Regards
Arvind

 

[DonkeyOte]

ws.Cells(Rows.Count, 9).End(xlUp).Font.Bold = True

 

[aravindhan_31]

Thanks Lasw,

But I am not sure where to add this line? please help me on this...

 

[DonkeyOte]

Depending on which solution you used for Total in I it will go after

xlPasteValues command -- Kris' method

or

Formula Insert command -- my method

 

[aravindhan_31]

Hi,

Thanks a lot.... its working.....

Arvind..

 

[aravindhan_31]

Hi,

Another question on the same code, Sorry if I am troubling much,

on the data sheet, the header that is the first Row, I formated with alingment, colour etc, is it possible to copy the header with the format in other sheets?


Arvind...

 

[aravindhan_31]

Hi,

Any ideas...

Arvind...