Create Detail Sheets from Pivot Table

L

Lucas B

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 Before:=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
 
L

Lucas B

I've received an answer, change ActiveCell.Offset(2, 1).Select to
ActiveCell.Offset(1, 1).Select and it works perfectly.

Lucas B said:
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 Before:=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
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

works in 2007 but not in 2010 0
Count Duplicates 8
If Cells.Find returns run-time error '91': Object variableor With block variable not set 1
Sort problem 6
Totals An Easier Way?? 5
Error 2007 0
VBA Pivot Table Error 1
R[1]C[1] with a variable 2

Top