Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Create Detail Sheets from Pivot Table
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 12
Default Create Detail Sheets from Pivot Table
I have a macro that creates detail tabs from a pivot table if the value of
the cell is greater than 20. My problem is that for some reason the pivot is
excluding the first and last cell that meet this criteria. Specifically, my
pivot sorts in descending order and I have 59 cells that are greater than 20
beginning at B3 and ending at B61. My macro gives me detail tabs for all
cells from B4 to B60.

Any help would be appreciated.

Sub CreateSiteTabs()

Dim CopyTab As String
Dim PasteTab As String
Dim StartCell As Variant
Dim EndCell As Variant
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Long
Dim EndCol As Long

Sheets("PIVOT").Select
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:="R3C2:R2000C2", Order1:=xlDescending, Type:= _
xlSortValues, OrderCustom:=1, Orientation:=xlTopToBottom

Application.ScreenUpdating = False

Sheets("PIVOT").Select
Range("A1").Select
Cells.Find(What:="Key", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
CopyTab = ActiveCell.Offset(1, 0).Value

ActiveCell.Offset(2, 1).Select
Do Until ActiveCell.Value < 20
PasteTab = ActiveCell.Offset(0, -1).Value
Selection.ShowDetail = True
ActiveSheet.Name = PasteTab
Sheets(PasteTab).Move Befo=Sheets("END SHEET")
Sheets(PasteTab).Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("J1").Select
ActiveCell.FormulaR1C1 = "Median Drive Distance"
Range("K1").Select
ActiveCell.FormulaR1C1 = "=MEDIAN(R[2]C:R[65531]C)"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Median Drive Time"
Range("M1").Select
ActiveCell.FormulaR1C1 = "=MEDIAN(R[2]C:R[65531]C)"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Median Unload Time"
Range("P1").Select
ActiveCell.FormulaR1C1 = "=MEDIAN(R[2]C:R[65531]C)"
Range("J2").Select
ActiveCell.FormulaR1C1 = "Average Drive Distance"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[65530]C)"
Range("L2").Select
ActiveCell.FormulaR1C1 = "Average Drive Time"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[65530]C)"
Range("O2").Select
ActiveCell.FormulaR1C1 = "Average Unload Time"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[65530]C)"
Cells.Find(What:="Drive less delay", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
StartCell = ActiveCell.Offset(1, 0).Address
StartRow = ActiveCell.Offset(1, 0).Row
Range(StartCell).End(xlDown).Select
EndCell = ActiveCell.Address
EndRow = ActiveCell.Row
Range(StartCell, EndCell).Select
Application.CutCopyMode = False
Selection.NumberFormat = "h:mm:ss"
Rows("3:3").Select
Cells.Find(What:="Unloading less delays", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
StartCol = ActiveCell.Offset(1, 0).Column
Range(Cells(StartRow, StartCol), Cells(EndRow, StartCol)).Select
Application.CutCopyMode = False
Selection.NumberFormat = "h:mm:ss"
Rows("3:3").Select
Cells.Find(What:="From Site ID", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
StartCell = ActiveCell.Address
StartCol = ActiveCell.Column
StartRow = ActiveCell.Row
Range(StartCell).End(xlToRight).Select
EndCell = ActiveCell.Address
EndCol = ActiveCell.Column
Range(StartCell, EndCell).Select
With Selection
.RowHeight = 45
.WrapText = True
End With
Range(Cells(StartRow, StartCol), Cells(EndRow, EndCol)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
End With
Selection.Sort Key1:="Trip Date", Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveSheet.Tab.ColorIndex = 5

Sheets("PIVOT").Select
ActiveCell.Offset(1, 0).Select

Loop
Application.ScreenUpdating = True
Sheets("MACRO").Select

End Sub

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 12
Default Create Detail Sheets from Pivot Table
I've received an answer, change ActiveCell.Offset(2, 1).Select to
ActiveCell.Offset(1, 1).Select and it works perfectly.

"Lucas B" wrote:

I have a macro that creates detail tabs from a pivot table if the value of
the cell is greater than 20. My problem is that for some reason the pivot is
excluding the first and last cell that meet this criteria. Specifically, my
pivot sorts in descending order and I have 59 cells that are greater than 20
beginning at B3 and ending at B61. My macro gives me detail tabs for all
cells from B4 to B60.

Any help would be appreciated.

Sub CreateSiteTabs()

Dim CopyTab As String
Dim PasteTab As String
Dim StartCell As Variant
Dim EndCell As Variant
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Long
Dim EndCol As Long

Sheets("PIVOT").Select
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:="R3C2:R2000C2", Order1:=xlDescending, Type:= _
xlSortValues, OrderCustom:=1, Orientation:=xlTopToBottom

Application.ScreenUpdating = False

Sheets("PIVOT").Select
Range("A1").Select
Cells.Find(What:="Key", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
CopyTab = ActiveCell.Offset(1, 0).Value

ActiveCell.Offset(2, 1).Select
Do Until ActiveCell.Value < 20
PasteTab = ActiveCell.Offset(0, -1).Value
Selection.ShowDetail = True
ActiveSheet.Name = PasteTab
Sheets(PasteTab).Move Befo=Sheets("END SHEET")
Sheets(PasteTab).Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("J1").Select
ActiveCell.FormulaR1C1 = "Median Drive Distance"
Range("K1").Select
ActiveCell.FormulaR1C1 = "=MEDIAN(R[2]C:R[65531]C)"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Median Drive Time"
Range("M1").Select
ActiveCell.FormulaR1C1 = "=MEDIAN(R[2]C:R[65531]C)"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Median Unload Time"
Range("P1").Select
ActiveCell.FormulaR1C1 = "=MEDIAN(R[2]C:R[65531]C)"
Range("J2").Select
ActiveCell.FormulaR1C1 = "Average Drive Distance"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[65530]C)"
Range("L2").Select
ActiveCell.FormulaR1C1 = "Average Drive Time"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[65530]C)"
Range("O2").Select
ActiveCell.FormulaR1C1 = "Average Unload Time"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[65530]C)"
Cells.Find(What:="Drive less delay", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
StartCell = ActiveCell.Offset(1, 0).Address
StartRow = ActiveCell.Offset(1, 0).Row
Range(StartCell).End(xlDown).Select
EndCell = ActiveCell.Address
EndRow = ActiveCell.Row
Range(StartCell, EndCell).Select
Application.CutCopyMode = False
Selection.NumberFormat = "h:mm:ss"
Rows("3:3").Select
Cells.Find(What:="Unloading less delays", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
StartCol = ActiveCell.Offset(1, 0).Column
Range(Cells(StartRow, StartCol), Cells(EndRow, StartCol)).Select
Application.CutCopyMode = False
Selection.NumberFormat = "h:mm:ss"
Rows("3:3").Select
Cells.Find(What:="From Site ID", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True, SearchFormat:=False).Select
StartCell = ActiveCell.Address
StartCol = ActiveCell.Column
StartRow = ActiveCell.Row
Range(StartCell).End(xlToRight).Select
EndCell = ActiveCell.Address
EndCol = ActiveCell.Column
Range(StartCell, EndCell).Select
With Selection
.RowHeight = 45
.WrapText = True
End With
Range(Cells(StartRow, StartCol), Cells(EndRow, EndCol)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
End With
Selection.Sort Key1:="Trip Date", Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveSheet.Tab.ColorIndex = 5

Sheets("PIVOT").Select
ActiveCell.Offset(1, 0).Select

Loop
Application.ScreenUpdating = True
Sheets("MACRO").Select

End Sub

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
How can I detail Pivot Table data without creating a table (Excel2007) Skeletiko[_2_] Excel Discussion (Misc queries) 1 May 5th 10 08:22 AM
How can I detail Pivot Table data without creating a table (Excel2007) Skeletiko Excel Discussion (Misc queries) 0 May 5th 10 12:21 AM
How do i create pivot table from 2 sheets. Francis Excel Discussion (Misc queries) 1 June 28th 06 01:40 PM
create pivot table with master/detail data from 2 worksheets BarbaraT Excel Worksheet Functions 0 April 17th 06 11:31 PM
Pivot Table--How can I create from multiple sheets? penciline New Users to Excel 3 February 22nd 06 06:25 AM


All times are GMT +1. The time now is 04:06 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement