Macros - Subtotals/Sorting

A

Amber M

I may be way over my head on this one...

I'm creating a template so that I can enter in a running total of job #'s
and their supplies. One job # may appear more than once in my spreadsheet.
I'm trying to create a macro that will sort by job number (column A), and
then provide subtotals for columns B thru J. Next, I want the grand totals of
each column (B thru H) to be multiplied by the set amt indicated above the
column name. (The amts will stay at B5 thru H5). The grand total of column J
should just be copied down to the same row as the multiplied amounts. Lastly,
I added all of the new multiplied totals and then multiplied them by a
percentage (that will often increase/decrease) in D1. That amt should appear
in I1. The same goes for another percentage in E2 which needs to appear in
I2. With that said, my macro is erroring out. Though it will be large, I've
copied it for help. Please ask questions if need be... I'm in dire need.
THANK YOU!

Sub PieceWork()
'
' PieceWork Macro
' Piece Work
'
' Keyboard Shortcut: Ctrl+r
'
ActiveCell.Offset(-6, -8).Range("A1:J34").Select
ActiveCell.Offset(1, 0).Range("A1:J34").Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=0
ActiveCell.Offset(-1, 0).Range("A1:J33").Select
ActiveCell.Offset(1, 0).Range("A1:J33").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3,
4, 5, _
6, 7, 8, 10), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=27
ActiveCell.Offset(40, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C*R[-41]C)"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:G1"), Type:= _
xlFillDefault
ActiveCell.Range("A1:G1").Select
ActiveCell.Offset(0, 4).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 5).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 6).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(-11, 5).Range("A1").Select
ActiveWindow.SmallScroll Down:=3
ActiveCell.Offset(11, 3).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C)"
ActiveCell.Select
Selection.NumberFormat = "$#,##0.00"
ActiveWindow.SmallScroll Down:=-30
ActiveCell.Offset(-45, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = _

"=SUM((R[45]C[-7]+R[45]C[-6]+R[45]C[-5]+R[45]C[-4]+R[45]C[-3]+R[45]C[-2]+R[45]C[-1]+R[45]C[1])*RC[-5])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = _

"=SUM((R[44]C[-7]+R[44]C[-6]+R[44]C[-5]+R[44]C[-4]+R[44]C[-3]+R[44]C[-2]+R[44]C[-1]+R[44]C[1])*RC[-5])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll ToRight:=1
ActiveCell.Offset(0, -2).Range("A1").Select
ActiveWindow.SmallScroll Down:=33
 
D

Dave Peterson

First, it's difficult to decipher what range contained what. You recorded
everything as relative to the activecell. And if I don't start on the same
cell, then everything will be off.

So I made some assumptions (that you can change).

Row 5 (b5:h5) held the multipliers
Row 6 held a single row of headers
Column A has an entry for each row (I used column A to find the last row of the
range).

I hope you'll be able to modify it if I guessed incorrectly:

Option Explicit
Sub PieceWork()

Dim myRng As Range
Dim MultiplierRow As Long
Dim wks As Worksheet
Dim ResultRow As Long
Dim myAdjustedRng As Range

Set wks = Worksheets("sheet1")
MultiplierRow = 5

With wks
Set myRng = .Range("A6:J" & .Cells(.Rows.Count, "A").End(xlUp).Row)

With myRng
.Cells.Sort key1:=.Columns(1), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

.Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(2, 3, 4, 5, 6, 7, 8, 10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With

'move down 2 rows and add multiplier to totals.
ResultRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 2

.Cells(ResultRow, "A").Value = "Semi Adjusted Total"

Set myAdjustedRng = .Range(.Cells(ResultRow, "B"), _
.Cells(ResultRow, "H"))

myAdjustedRng.Formula = "=B" & ResultRow - 2 & "+B5"

.Cells(ResultRow, "J").Formula = "=J" & ResultRow - 2

.Range("I1").Formula _
= "=sum(" & myAdjustedRng.Address & ")*D1"

.Range("I2").Formula _
= "=sum(" & myAdjustedRng.Address & ")*E2"

End With

End Sub


Amber said:
I may be way over my head on this one...

I'm creating a template so that I can enter in a running total of job #'s
and their supplies. One job # may appear more than once in my spreadsheet.
I'm trying to create a macro that will sort by job number (column A), and
then provide subtotals for columns B thru J. Next, I want the grand totals of
each column (B thru H) to be multiplied by the set amt indicated above the
column name. (The amts will stay at B5 thru H5). The grand total of column J
should just be copied down to the same row as the multiplied amounts. Lastly,
I added all of the new multiplied totals and then multiplied them by a
percentage (that will often increase/decrease) in D1. That amt should appear
in I1. The same goes for another percentage in E2 which needs to appear in
I2. With that said, my macro is erroring out. Though it will be large, I've
copied it for help. Please ask questions if need be... I'm in dire need.
THANK YOU!

Sub PieceWork()
'
' PieceWork Macro
' Piece Work
'
' Keyboard Shortcut: Ctrl+r
'
ActiveCell.Offset(-6, -8).Range("A1:J34").Select
ActiveCell.Offset(1, 0).Range("A1:J34").Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=0
ActiveCell.Offset(-1, 0).Range("A1:J33").Select
ActiveCell.Offset(1, 0).Range("A1:J33").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3,
4, 5, _
6, 7, 8, 10), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=27
ActiveCell.Offset(40, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C*R[-41]C)"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:G1"), Type:= _
xlFillDefault
ActiveCell.Range("A1:G1").Select
ActiveCell.Offset(0, 4).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 5).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 6).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(-11, 5).Range("A1").Select
ActiveWindow.SmallScroll Down:=3
ActiveCell.Offset(11, 3).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C)"
ActiveCell.Select
Selection.NumberFormat = "$#,##0.00"
ActiveWindow.SmallScroll Down:=-30
ActiveCell.Offset(-45, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = _

"=SUM((R[45]C[-7]+R[45]C[-6]+R[45]C[-5]+R[45]C[-4]+R[45]C[-3]+R[45]C[-2]+R[45]C[-1]+R[45]C[1])*RC[-5])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = _

"=SUM((R[44]C[-7]+R[44]C[-6]+R[44]C[-5]+R[44]C[-4]+R[44]C[-3]+R[44]C[-2]+R[44]C[-1]+R[44]C[1])*RC[-5])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll ToRight:=1
ActiveCell.Offset(0, -2).Range("A1").Select
ActiveWindow.SmallScroll Down:=33
Click to expand...
 
A

Amber M

Thanks, Dave. I'll try it out and let you know.


Dave Peterson said:
First, it's difficult to decipher what range contained what. You recorded
everything as relative to the activecell. And if I don't start on the same
cell, then everything will be off.

So I made some assumptions (that you can change).

Row 5 (b5:h5) held the multipliers
Row 6 held a single row of headers
Column A has an entry for each row (I used column A to find the last row of the
range).

I hope you'll be able to modify it if I guessed incorrectly:

Option Explicit
Sub PieceWork()

Dim myRng As Range
Dim MultiplierRow As Long
Dim wks As Worksheet
Dim ResultRow As Long
Dim myAdjustedRng As Range

Set wks = Worksheets("sheet1")
MultiplierRow = 5

With wks
Set myRng = .Range("A6:J" & .Cells(.Rows.Count, "A").End(xlUp).Row)

With myRng
.Cells.Sort key1:=.Columns(1), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

.Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(2, 3, 4, 5, 6, 7, 8, 10), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With

'move down 2 rows and add multiplier to totals.
ResultRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 2

.Cells(ResultRow, "A").Value = "Semi Adjusted Total"

Set myAdjustedRng = .Range(.Cells(ResultRow, "B"), _
.Cells(ResultRow, "H"))

myAdjustedRng.Formula = "=B" & ResultRow - 2 & "+B5"

.Cells(ResultRow, "J").Formula = "=J" & ResultRow - 2

.Range("I1").Formula _
= "=sum(" & myAdjustedRng.Address & ")*D1"

.Range("I2").Formula _
= "=sum(" & myAdjustedRng.Address & ")*E2"

End With

End Sub


Amber said:
I may be way over my head on this one...

I'm creating a template so that I can enter in a running total of job #'s
and their supplies. One job # may appear more than once in my spreadsheet.
I'm trying to create a macro that will sort by job number (column A), and
then provide subtotals for columns B thru J. Next, I want the grand totals of
each column (B thru H) to be multiplied by the set amt indicated above the
column name. (The amts will stay at B5 thru H5). The grand total of column J
should just be copied down to the same row as the multiplied amounts. Lastly,
I added all of the new multiplied totals and then multiplied them by a
percentage (that will often increase/decrease) in D1. That amt should appear
in I1. The same goes for another percentage in E2 which needs to appear in
I2. With that said, my macro is erroring out. Though it will be large, I've
copied it for help. Please ask questions if need be... I'm in dire need.
THANK YOU!

Sub PieceWork()
'
' PieceWork Macro
' Piece Work
'
' Keyboard Shortcut: Ctrl+r
'
ActiveCell.Offset(-6, -8).Range("A1:J34").Select
ActiveCell.Offset(1, 0).Range("A1:J34").Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=0
ActiveCell.Offset(-1, 0).Range("A1:J33").Select
ActiveCell.Offset(1, 0).Range("A1:J33").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3,
4, 5, _
6, 7, 8, 10), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=27
ActiveCell.Offset(40, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C*R[-41]C)"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:G1"), Type:= _
xlFillDefault
ActiveCell.Range("A1:G1").Select
ActiveCell.Offset(0, 4).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 5).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 6).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(-11, 5).Range("A1").Select
ActiveWindow.SmallScroll Down:=3
ActiveCell.Offset(11, 3).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C)"
ActiveCell.Select
Selection.NumberFormat = "$#,##0.00"
ActiveWindow.SmallScroll Down:=-30
ActiveCell.Offset(-45, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = _

"=SUM((R[45]C[-7]+R[45]C[-6]+R[45]C[-5]+R[45]C[-4]+R[45]C[-3]+R[45]C[-2]+R[45]C[-1]+R[45]C[1])*RC[-5])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = _

"=SUM((R[44]C[-7]+R[44]C[-6]+R[44]C[-5]+R[44]C[-4]+R[44]C[-3]+R[44]C[-2]+R[44]C[-1]+R[44]C[1])*RC[-5])"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll ToRight:=1
ActiveCell.Offset(0, -2).Range("A1").Select
ActiveWindow.SmallScroll Down:=33
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Problem with Macro 7
Help linking true false in column to start macros 3
Macro 3
Hopefully a real easy vba question 2
type mismatch error in macro in excel 0
Formula R1C1 in VBA - Strange Results (Dynamic) 2
works in 2007 but not in 2010 0
Change data with a macro 8

Top