Copy detail into subtotal line

[Steve Garman]

Can anyone suggest an easy way to copy a value to each subtotal line
from the line above.

This comes about because a simple job has just become slightly more
complicated.

Originally, as a one-off job, I was presented with a .csv file
containing 15000 rows and 7 columns
Branch, Product, Indicator and 4 numeric fields

The csv file is sorted by product and each product occurs in a random
number (1 to 11) of adjacent rows.

I was asked to create a list of the products where every numeric field
in every row was zero.
I achieved this by adding a helper column summing the absolute values,
subtotalling each product, pasting visible cells (the subtotals) into a
new worksheet and filtering out non-zero totals.

I then just printed the new sheet.

This was too successful I now have to make this available for others
to run.

I've recorded a macro and tidied it up half-heartedly and it replicates
what I did originally (see below.)

However, now I am told "it would be nice" if the indicator (column C)
from the original .csv would appear on the printed output.

Any suggestions for a simple way to achieve this would be much
appreciated. Also any comments on improvements to the subroutine in
general. Pehaps I shouldn't be using automatic subtotals at all.

Sub testit()
Dim wb As Workbook, ws As Worksheet, ws2 As Worksheet
Dim r&, maxR&, c%, rng As Range
Set wb = Workbooks.Open("C:\import\BRSGS.CSV")
Set ws = wb.Sheets(1)
With ws
Set rng = .UsedRange
maxR& = rng.Rows.Count
c% = rng.Columns.Count + 1
For r& = 1 To maxR&
rng.Cells(r&, c%).FormulaR1C1 = _
"=abs(RC[-4])+abs(RC[-3])+abs(RC[-2])+abs(RC[-1])"
Next r&
Set rng = .UsedRange
rng.Rows("1:1").Insert Shift:=xlDown
.Range("A1").Formula = "Bch"
.Range("B1").Formula = "Prod"
.Range("C1").Formula = "Smopd"
.Range("D1").Formula = "Free"
.Range("E1").Formula = "Phys"
.Range("F1").Formula = "P1"
.Range("G1").Formula = "P2"
.Range("H1").Formula = "Total"
Set rng = .UsedRange
rng.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(8), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Outline.ShowLevels RowLevels:=2
End With
Set ws2 = wb.Sheets.Add
ws2.Name = "Filtered"
ws.Select
'ws.Cells.SpecialCells(xlCellTypeVisible).Select
'Selection.Copy
ws.Cells.SpecialCells(xlCellTypeVisible).Copy
With ws2
.Paste
Application.CutCopyMode = False
.UsedRange.RemoveSubtotal
.Activate
.Columns(1).Delete Shift:=xlToLeft
.Columns(1).EntireColumn.AutoFit
.Columns("B:F").Delete Shift:=xlToLeft
'.Cells.AutoFilter
.Range("A2").AutoFilter Field:=2, Criteria1:="0"
.Cells(1, 1).Select
End With
wb.SaveAs "C:\import\BR_SGS.xls", xlNormal
End Sub

 

[Steve Garman]

Can anyone suggest an easy way to copy a value to each subtotal line
from the line above.

I managed to come up with a simple solution to this myself in the end.

As the only blank cells in te column were on subtotal lines, I just used

For Each cel In rng.Columns("C:C").Cells
If cel.Formula = "" Then cel.Formula = "=R[-1]C"
Next cel

Any comments on whether the for/next loops in the code are a sensible
way to go would still be appreciated though.