Macro: Copying to all possible rows

C

childofthe1980s

Hello:

Could someone please review my code and the thread below and give me some
options? The thread is on the second or third page of this message baord
already, and I fear that it is getting ignored.

Hi:

My code is below. As far as what it accomplishes, please review toward the
end. I am copying three sets of formulas into three columns (one formula per
column).

Thanks, for looking at this.

Sub Consolidated()
'
' Consolidated Macro
' Macro recorded 4/21/2008 by John Ellis
'
'
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R1864C12").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Item Number")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Qty On Hand"), "Sum of Qty On Hand", xlSum
Range("B5").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Qty On
Hand"). _
Function = xlAverage
Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("F:I").Select
Selection.Delete Shift:=xlToLeft
Range("G1").Select
ActiveCell.FormulaR1C1 = "Past Due"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Due This Week"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Due in the Future"
Columns("I:I").Select
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<TODAY(), RC[-3], 0)"
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-2]>TODAY(), RC[-2]<TODAY()+7), RC[-4], 0)"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>TODAY(), RC[-5], 0)"
Range("G2:I2").Select
Selection.Copy
Range("G3:I1864").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8,
9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

childofthe1980s
 
J

Joel

I used data in column A to determine the last row. I also cleaned up the code.

Sub Consolidated()
'
' Consolidated Macro
' Macro recorded 4/21/2008 by John Ellis
'
'
With ActiveSheet
ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlDatabase, _
SourceData:="Sheet1!R1C1:R1864C12").CreatePivotTable _
TableDestination:="", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
.PivotTableWizard TableDestination:=.Range("A3")
With .PivotTables("PivotTable1").PivotFields("Item Number")
.Orientation = xlRowField
.Position = 1
End With
.PivotTables("PivotTable1").AddDataField
.PivotTables("PivotTable1").PivotFields _
("Qty On Hand"), _
"Sum of Qty On Hand", _
xlSum

.PivotTables("PivotTable1"). _
PivotFields("Sum of Qty On Hand").Function = xlAverage
End With
With Sheets("Sheet1")
.Columns("A:B").Delete
.Columns("F:I").Delete
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("G1") = "Past Due"
.Range("H1") = "Due This Week"
.Range("I1") = "Due in the Future"
.Columns("H:H").EntireColumn.AutoFit
.Columns("I:I").EntireColumn.AutoFit
.Range("G" & LastRow).FormulaR1C1 = "=IF(RC[-1]<TODAY(), RC[-3], 0)"
.Range("H" & LastRow).FormulaR1C1 = _
"=IF(AND(RC[-2]>TODAY(), RC[-2]<TODAY()+7), RC[-4], 0)"
.Range("I" & LastRow).FormulaR1C1 = "=IF(RC[-3]>TODAY(), RC[-5], 0)"
.Range("G2:I2").Copy _
Destination:=.Range("G3")
.Range("A1").Subtotal _
GroupBy:=1, _
Function:=xlSum, _
TotalList:=Array(7, 8, 9), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True
End With
End Sub



childofthe1980s said:
Hello:

Could someone please review my code and the thread below and give me some
options? The thread is on the second or third page of this message baord
already, and I fear that it is getting ignored.

Hi:

My code is below. As far as what it accomplishes, please review toward the
end. I am copying three sets of formulas into three columns (one formula per
column).

Thanks, for looking at this.

Sub Consolidated()
'
' Consolidated Macro
' Macro recorded 4/21/2008 by John Ellis
'
'
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R1864C12").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Item Number")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Qty On Hand"), "Sum of Qty On Hand", xlSum
Range("B5").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Qty On
Hand"). _
Function = xlAverage
Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("F:I").Select
Selection.Delete Shift:=xlToLeft
Range("G1").Select
ActiveCell.FormulaR1C1 = "Past Due"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Due This Week"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Due in the Future"
Columns("I:I").Select
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<TODAY(), RC[-3], 0)"
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-2]>TODAY(), RC[-2]<TODAY()+7), RC[-4], 0)"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>TODAY(), RC[-5], 0)"
Range("G2:I2").Select
Selection.Copy
Range("G3:I1864").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8,
9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

childofthe1980s

someone said:
The snippet of code I gave you only defines and selects the range from G3 to
the last entry in Column I, and it will do that every time. How are you
using that line of code? Post your code and explain what it does and what
it is supposed to do. HTH someone
Click to expand...
Click to expand...
 
C

childofthe1980s

Thanks so much, Joel! This is great!

childofthe1980s

Joel said:
I used data in column A to determine the last row. I also cleaned up the code.

Sub Consolidated()
'
' Consolidated Macro
' Macro recorded 4/21/2008 by John Ellis
'
'
With ActiveSheet
ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlDatabase, _
SourceData:="Sheet1!R1C1:R1864C12").CreatePivotTable _
TableDestination:="", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
.PivotTableWizard TableDestination:=.Range("A3")
With .PivotTables("PivotTable1").PivotFields("Item Number")
.Orientation = xlRowField
.Position = 1
End With
.PivotTables("PivotTable1").AddDataField
.PivotTables("PivotTable1").PivotFields _
("Qty On Hand"), _
"Sum of Qty On Hand", _
xlSum

.PivotTables("PivotTable1"). _
PivotFields("Sum of Qty On Hand").Function = xlAverage
End With
With Sheets("Sheet1")
.Columns("A:B").Delete
.Columns("F:I").Delete
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("G1") = "Past Due"
.Range("H1") = "Due This Week"
.Range("I1") = "Due in the Future"
.Columns("H:H").EntireColumn.AutoFit
.Columns("I:I").EntireColumn.AutoFit
.Range("G" & LastRow).FormulaR1C1 = "=IF(RC[-1]<TODAY(), RC[-3], 0)"
.Range("H" & LastRow).FormulaR1C1 = _
"=IF(AND(RC[-2]>TODAY(), RC[-2]<TODAY()+7), RC[-4], 0)"
.Range("I" & LastRow).FormulaR1C1 = "=IF(RC[-3]>TODAY(), RC[-5], 0)"
.Range("G2:I2").Copy _
Destination:=.Range("G3")
.Range("A1").Subtotal _
GroupBy:=1, _
Function:=xlSum, _
TotalList:=Array(7, 8, 9), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True
End With
End Sub



childofthe1980s said:
Hello:

Could someone please review my code and the thread below and give me some
options? The thread is on the second or third page of this message baord
already, and I fear that it is getting ignored.

Hi:

My code is below. As far as what it accomplishes, please review toward the
end. I am copying three sets of formulas into three columns (one formula per
column).

Thanks, for looking at this.

Sub Consolidated()
'
' Consolidated Macro
' Macro recorded 4/21/2008 by John Ellis
'
'
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R1864C12").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Item Number")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Qty On Hand"), "Sum of Qty On Hand", xlSum
Range("B5").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Qty On
Hand"). _
Function = xlAverage
Sheets("Sheet1").Select
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("F:I").Select
Selection.Delete Shift:=xlToLeft
Range("G1").Select
ActiveCell.FormulaR1C1 = "Past Due"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Due This Week"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Due in the Future"
Columns("I:I").Select
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<TODAY(), RC[-3], 0)"
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-2]>TODAY(), RC[-2]<TODAY()+7), RC[-4], 0)"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]>TODAY(), RC[-5], 0)"
Range("G2:I2").Select
Selection.Copy
Range("G3:I1864").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8,
9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

childofthe1980s

someone said:
The snippet of code I gave you only defines and selects the range from G3 to
the last entry in Column I, and it will do that every time. How are you
using that line of code? Post your code and explain what it does and what
it is supposed to do. HTH someone
message Hello:

I have created a macro that, among other things, copies a formula from the
first row of records to the remaining rows of records in the spreadsheet
of
data that I exported to Excel from an accounting application.

Now, is there a way in VBA Editor that I can tell the macro to copy this
formula to any and all possible records that are exported to Excel? I can
see where, if there are more or less records exported during the next
export,
that some of the programming can be "lost" and either too little or too
much
pasting of rows can be done.

Here is the range "line item" in VBA Editor that I need to edit:
Range("G3:I1864").Select

I need to, in essence, take out the I1864 and put in whatever the possible
last cell could be. That way the macro will select (before pasting) the
complete possible range of records.

I don't want to use the last cell in Excel, as that would force the clinet
to have to hunt to the bottom of the world to find the last record. I
just
want to have the macro copy to the last possible record.

I posted this question yesterday on the message board. But, the solution
given to me by someone else frankly did not work. It gave me debugging
errors. And, with the line item that I just gave you in VBA Editor, there
was not a way to take his code and "marry" it to mine.

Please help!

childofthe1980s
Click to expand...
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

VBA Pivot Table Error 1
Creating Pivot Table with Macro using Multiple Sheets 0
Format Pivot total rows 2
Remover ODBC Dialog Box 0
Loop through sheets and create a small PivotTable on each 2
Different Results from the Same Macro 3
variable number of rows. 3
syntax in VBA to create a pivot table 2

Top