ActiveCell.FormulaR1C1
(1)
Selection.Rows.Count
(1)
Office
(1)
SUBTOTAL
(1)
SUM
(1)
Rows.Count
(1)
LongMycolumns
(1)
InputRow
(1)

Cleaner coding to repeat process

Asked By Rob
09-Feb-10 08:36 AM
I have the code below that does what I want but seem untidy and I feel it
could be done in a cleaner way.  This code runs and in columns K, L, R, S, T
and U it added a formula below the last row of data.  As you will see, the
code first finds the last row and RowCount is used in the formula.

Is there an easier way to achieve what I am looking for and a way in which
would be easier to change in the future if needed?

Thansk, Rob

Sub Subtotal()
Dim RowCount As Long
Range("K1").Select
Range(Selection, Selection.End(xlDown)).Select
RowCount = Selection.Rows.Count
Range("K1").Select
Range("K" + CStr(RowCount + 2)).Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-" + CStr(RowCount) & "]C:R[-1]C)"
Range("L1").Select
Range("L" + CStr(RowCount + 2)).Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-" + CStr(RowCount) & "]C:R[-1]C1)"
Range("R1").Select
Range("R" + CStr(RowCount + 2)).Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-" + CStr(RowCount) & "]C:R[-1]C)"
Range("S1").Select
Range("S" + CStr(RowCount + 2)).Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-" + CStr(RowCount) & "]C:R[-1]C)"
Range("T1").Select
Range("T" + CStr(RowCount + 2)).Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-" + CStr(RowCount) & "]C:R[-1]C)"
Range("U1").Select
Range("U" + CStr(RowCount + 2)).Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-" + CStr(RowCount) & "]C:R[-1]C)"
End Sub

Give this a try.

Ryan H replied to Rob
09-Feb-10 10:05 AM
Give this a try.  I basically made an array of columns you wish to put the
totals in.  Then wrote a loop that loops through the columns in the array,
finding the last row, then inserting your formula.  Hope this helps!  If so,
let me know, click "YES" below.

Sub SubTotal()

Dim MyArray As Variant
Dim i As Long
Dim InputRow As Long

MyArray = Array("K", "L", "R", "S", "T", "U")

For i = LBound(MyArray) To UBound(MyArray)
InputRow = Cells(Rows.Count, MyArray(i)).End(xlUp).Row + 2
Cells(InputRow, MyArray(i)).Formula = "=SUBTOTAL(9,R[-" & InputRow &
Next i

End Sub
--
Cheers,
Ryan

Sub Subtotal()Dim RowCount As LongMycolumns =

joel replied to Rob
09-Feb-10 10:09 AM
Sub Subtotal()
Dim RowCount As Long

Mycolumns = Array("K","L","R","S","T","U")


LastRow = Range("K" & rows.count).end(xlup).row
AddRow = LastRow + 2
for each Col in Mycolumns
Range(Col & AddRow).FormulaR1C1 = "=SUBTOTAL(9,R[-" + CStr(AddRow) &

next Col

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=177668

[url="http://www.thecodecage.com"]Microsoft Office Help[/url]

Ryan,Thanks.

Rob replied to Ryan H
09-Feb-10 10:34 AM
Ryan,

Thanks.  I have tried this and whilst I have some errors insomuch that the
formula reads =SUBTOTAL(9,K961:K65356), I will try and figure out what is
happening.

Thanks again, Rob
What range are you wanting to sum?
Ryan H replied to Rob
09-Feb-10 12:10 PM
What range are you wanting to sum?  You may not need to use R1C1 notation
style.
--
Cheers,
Ryan
If the last row of data was in K960, I would want the formula to readK2:K960.
Rob replied to Ryan H
09-Feb-10 12:22 PM
If the last row of data was in K960, I would want the formula to read
K2:K960.  Row 1 has a header hence the formula starting at K2.

Thanks, Rob
Try this code instead. This worked for me. Its a bit different.
Ryan H replied to Rob
09-Feb-10 01:20 PM
Try this code instead.  This worked for me.  Its a bit different.  Hope this
helps!  If so, let me know, click "YES" below.

Sub SubTotal()

Dim MyArray As Variant
Dim i As Long
Dim LastRow As Long
Dim MyFormula As String

MyArray = Array("K", "L", "R", "S", "T", "U")

For i = LBound(MyArray) To UBound(MyArray)
LastRow = Cells(Rows.Count, MyArray(i)).End(xlUp).Row
MyFormula = "=SUM(" & MyArray(i) & "2:" & MyArray(i) & LastRow & ")"
Cells(LastRow + 2, MyArray(i)).Formula = MyFormula
Next i

End Sub
--
Cheers,
Ryan
Ryan,Again thanks, have adapted to suit my needs and learnt much from
Rob replied to Ryan H
09-Feb-10 03:41 PM
Ryan,

Again thanks, have adapted to suit my needs and learnt much from your
experience.

Ta, Rob
Post Question To EggHeadCafe