Hi all, I'm hoping someone can point out what I'm missing. My macro was working fine until I tweaked it, by adding code to create 2 pivot tables. Now, when it returns to the previous code that finds and highlights a specific Subtotal row, it can't find it. If I remove the new code, the macro highlights the row just fine. I'm assuming then that the issue is within the code for the pivot tables but I can't figure it out. Thank you in advance for any info you can shed on this.
Here is my code:
----------------------------------------------------------------------------------------------------------------
Public mBook As String, rBook As String
Public REC As String, CNM As String
Public COLA As String, COLB As String
Public COLC As String, TP As String
Public MSWL As String, RECL As String
Public J As Integer, LC As Integer
Public Config As Integer, Ans As Integer
Public A As Integer, Z As Integer
Public X As Integer, Y As Integer
Public I As Integer
Public LR As Long, LRR As Long
Public LRD As Long, PLR As Long
Public DLR As Long
Sub Diversion()
'Turn off popup alerts/messages
Application.DisplayAlerts = False
'Name Diversion Report as mBook
mBook = ActiveWorkbook.Name
'Input boxes asking for Customer name, time period of report, MSW & REC lbs
CNM = InputBox("Enter your customer name as you would like it to appear on the chart.", _
"NB_Diversion Report Template - Company Name", _
"Your Customer")
If CNM = "" Then
Exit Sub
End If
TP = InputBox("Enter the time period of the report as you would like it to appear on the chart.", _
"NB_Diversion Report Template - Time Period", _
"2015 YTD")
If TP = "" Then
Exit Sub
End If
RECL = InputBox("Enter the REC lbs.", _
"NB_Diversion Report Template - REC LBS", _
"50")
If RECL = "" Then
Exit Sub
End If
MSWL = InputBox("Enter the MSW lbs.", _
"NB_Diversion Report Template - MSW LBS", _
"100")
If MSWL = "" Then
Exit Sub
End If
'Ensure the macro starts on the right tab
ThisWorkbook.Sheets("Diversion Detail").Activate
'Delete all CORP account lines if they exist (uses address, city, and ZIP)
X = ThisWorkbook.Worksheets("Diversion Detail").Range("L:L").Cells.SpecialCells(xlCellTypeConstants).Count
If X > 1 Then
With ThisWorkbook.Sheets("Diversion Detail")
.AutoFilterMode = False
With ThisWorkbook.Sheets("Diversion Detail").Range("E3", Range("E" & Rows.Count).End(xlUp))
.AutoFilter 1, "PO BOX 1234"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
On Error GoTo 0
End With
.AutoFilterMode = False
End With
Else
'do nada
End If
If X > 1 Then
With ThisWorkbook.Sheets("Diversion Detail")
.AutoFilterMode = False
With ThisWorkbook.Sheets("Diversion Detail").Range("E3", Range("E" & Rows.Count).End(xlUp))
.AutoFilter 1, "1234 Street"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
On Error GoTo 0
End With
.AutoFilterMode = False
End With
Else
'do nada
End If
'Identify last populated row
LR = ThisWorkbook.Worksheets("Diversion Detail").Cells(3, 12).End(xlDown).Row
'Copy format down to the last row
ThisWorkbook.Worksheets("Diversion Detail").Range("A4:W4").Copy
ThisWorkbook.Worksheets("Diversion Detail").Range("A5:W" & LR).PasteSpecial xlPasteFormats
'Delete all extra rows at the bottom
ThisWorkbook.Worksheets("Diversion Detail").Rows((LR + 1) & ":" & (LR + 1)).Select
ThisWorkbook.Worksheets("Diversion Detail").Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
'Sort by Diversion Stream
ThisWorkbook.Worksheets("Diversion Detail").Sort.SortFields.Clear
ThisWorkbook.Worksheets("Diversion Detail").Sort.SortFields.Add Key:=Range( _
"L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ThisWorkbook.Worksheets("Diversion Detail").Sort
.SetRange Range("A3:W" & LR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call Totals_Pivot
Call Summary_Pivot
-----------------------------------------------------------------------------------------------------------
Everything worked fine until I added the Call procedures above. The code for that is below:
-----------------------------------------------------------------------------------------------------------
Sub Totals_Pivot()
'Create Total tab info using pivot table code below
ThisWorkbook.Worksheets("Diversion Detail").Activate
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Diversion Detail!R3C1:R" & LR & "C23", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="'Totals Pivot'!R1C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
ThisWorkbook.Worksheets("Totals Pivot").Select
ThisWorkbook.Worksheets("Totals Pivot").Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Service Period")
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = False
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Diversion Stream")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Tonnage"), "Sum of Tonnage", xlSum
ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
'Find last row on Totals Pivot tab
PLR = ThisWorkbook.Worksheets("Totals Pivot").Cells(2, 1).End(xlDown).Row
'Copy/paste data to Totals Page tab
ThisWorkbook.Worksheets("Totals Page").Range("A2:D37").Value = ThisWorkbook.Worksheets("Totals Pivot").Range("A3:D" & PLR).Value
'Delete Grand Total from column A
With ThisWorkbook.Worksheets("Totals Page").Range("A2:A37")
.Replace what:="Grand Total", replacement:=""
End With
'Delete #N/A from column B
With ThisWorkbook.Worksheets("Totals Page").Range("B2:B37")
.Replace what:="#N/A", replacement:=""
End With
End Sub
Sub Summary_Pivot()
'Create Totals tab info using pivot table code below
ActiveWorkbook.Worksheets("Totals Pivot").PivotTables("PivotTable1").PivotCache.CreatePivotTable _
TableDestination:="'Summary Pivot'!R1C1", TableName:="PivotTable2", DefaultVersion _
:=xlPivotTableVersion14
Workbooks(mBook).Worksheets("Summary Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Location Code")
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = False
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Service Period")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Diversion Stream")
.Orientation = xlColumnField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("Tonnage"), "Sum of Tonnage", xlSum
ActiveSheet.PivotTables("PivotTable2").RowAxisLayout xlTabularRow
ActiveSheet.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels
ActiveSheet.PivotTables("PivotTable2").PivotFields("Diversion Stream"). _
CalculatedItems.Add "div %", "= SUM(RECYCLE )/(SUM(RECYCLE )+SUM(TRASH ))", _
True
'Replace nulls and errors with 0
ActiveSheet.PivotTables("PivotTable2").NullString = "0"
ActiveSheet.PivotTables("PivotTable2").DisplayErrorString = True
ActiveSheet.PivotTables("PivotTable2").ErrorString = "0"
End Sub
---------------------------------------------------------------------------------------------------------------
Now, when it goes back to the original code (below) it doesn't find the RECYCLE Total row to highlight it. While testing, I found that variable "I" doesn't obtain the row number of the RECYCLE Total row. The odd part (for me) is that it finds the TRASH Total row and highlights that one without any problems.
---------------------------------------------------------------------------------------------------------------
'Activate Diversion Detail tab
ThisWorkbook.Worksheets("Diversion Detail").Activate
'Add Subtotals
ThisWorkbook.Worksheets("Diversion Detail").Range("A3:W" & LR).Subtotal GroupBy:=12, Function:=xlSum, _
TotalList:=Array(18), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'Highlight and Bold Subtotal/Total rows if they exist
Dim DivWksht As Worksheet
Set DivWksht = ThisWorkbook.Worksheets("Diversion Detail")
Dim FoundCell1 As Range
Set FoundCell1 = DivWksht.Range("L:L").Find("RECYCLE Total", Range("L1"), xlValues, xlWhole, xlByColumns, xlNext)
If Not FoundCell1 Is Nothing Then
I = FoundCell1.Row
Else
'MsgBox "Still got a problem."
End If
If I = 0 Then
'do nada
Else
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).Interior.ThemeColor = xlThemeColorAccent2
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).Font.Bold = True
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).Font.ThemeColor = xlThemeColorDark1
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).NumberFormat = "_(#,##0.00_);_((#,##0.00);_("" - ""??_);_(@_)"
End If
Dim FoundCell2 As Range
Set FoundCell2 = DivWksht.Range("L:L").Find("TRASH Total", Range("L1"), xlValues, xlWhole, xlByColumns, xlNext)
If Not FoundCell2 Is Nothing Then
I = FoundCell2.Row
Else
'MsgBox "Still got a problem."
End If
If I = 0 Then
'do nada
Else
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).Interior.ThemeColor = xlThemeColorAccent2
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).Font.Bold = True
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).Font.ThemeColor = xlThemeColorDark1
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).NumberFormat = "_(#,##0.00_);_((#,##0.00);_("" - ""??_);_(@_)"
End If
----------------------------------------------------------------------------------------------------------------
There is more code after this but the only issue is the non highlighting of the RECYCLE Total row.
Here is my code:
----------------------------------------------------------------------------------------------------------------
Public mBook As String, rBook As String
Public REC As String, CNM As String
Public COLA As String, COLB As String
Public COLC As String, TP As String
Public MSWL As String, RECL As String
Public J As Integer, LC As Integer
Public Config As Integer, Ans As Integer
Public A As Integer, Z As Integer
Public X As Integer, Y As Integer
Public I As Integer
Public LR As Long, LRR As Long
Public LRD As Long, PLR As Long
Public DLR As Long
Sub Diversion()
'Turn off popup alerts/messages
Application.DisplayAlerts = False
'Name Diversion Report as mBook
mBook = ActiveWorkbook.Name
'Input boxes asking for Customer name, time period of report, MSW & REC lbs
CNM = InputBox("Enter your customer name as you would like it to appear on the chart.", _
"NB_Diversion Report Template - Company Name", _
"Your Customer")
If CNM = "" Then
Exit Sub
End If
TP = InputBox("Enter the time period of the report as you would like it to appear on the chart.", _
"NB_Diversion Report Template - Time Period", _
"2015 YTD")
If TP = "" Then
Exit Sub
End If
RECL = InputBox("Enter the REC lbs.", _
"NB_Diversion Report Template - REC LBS", _
"50")
If RECL = "" Then
Exit Sub
End If
MSWL = InputBox("Enter the MSW lbs.", _
"NB_Diversion Report Template - MSW LBS", _
"100")
If MSWL = "" Then
Exit Sub
End If
'Ensure the macro starts on the right tab
ThisWorkbook.Sheets("Diversion Detail").Activate
'Delete all CORP account lines if they exist (uses address, city, and ZIP)
X = ThisWorkbook.Worksheets("Diversion Detail").Range("L:L").Cells.SpecialCells(xlCellTypeConstants).Count
If X > 1 Then
With ThisWorkbook.Sheets("Diversion Detail")
.AutoFilterMode = False
With ThisWorkbook.Sheets("Diversion Detail").Range("E3", Range("E" & Rows.Count).End(xlUp))
.AutoFilter 1, "PO BOX 1234"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
On Error GoTo 0
End With
.AutoFilterMode = False
End With
Else
'do nada
End If
If X > 1 Then
With ThisWorkbook.Sheets("Diversion Detail")
.AutoFilterMode = False
With ThisWorkbook.Sheets("Diversion Detail").Range("E3", Range("E" & Rows.Count).End(xlUp))
.AutoFilter 1, "1234 Street"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
On Error GoTo 0
End With
.AutoFilterMode = False
End With
Else
'do nada
End If
'Identify last populated row
LR = ThisWorkbook.Worksheets("Diversion Detail").Cells(3, 12).End(xlDown).Row
'Copy format down to the last row
ThisWorkbook.Worksheets("Diversion Detail").Range("A4:W4").Copy
ThisWorkbook.Worksheets("Diversion Detail").Range("A5:W" & LR).PasteSpecial xlPasteFormats
'Delete all extra rows at the bottom
ThisWorkbook.Worksheets("Diversion Detail").Rows((LR + 1) & ":" & (LR + 1)).Select
ThisWorkbook.Worksheets("Diversion Detail").Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
'Sort by Diversion Stream
ThisWorkbook.Worksheets("Diversion Detail").Sort.SortFields.Clear
ThisWorkbook.Worksheets("Diversion Detail").Sort.SortFields.Add Key:=Range( _
"L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ThisWorkbook.Worksheets("Diversion Detail").Sort
.SetRange Range("A3:W" & LR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call Totals_Pivot
Call Summary_Pivot
-----------------------------------------------------------------------------------------------------------
Everything worked fine until I added the Call procedures above. The code for that is below:
-----------------------------------------------------------------------------------------------------------
Sub Totals_Pivot()
'Create Total tab info using pivot table code below
ThisWorkbook.Worksheets("Diversion Detail").Activate
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Diversion Detail!R3C1:R" & LR & "C23", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="'Totals Pivot'!R1C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
ThisWorkbook.Worksheets("Totals Pivot").Select
ThisWorkbook.Worksheets("Totals Pivot").Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Service Period")
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = False
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Diversion Stream")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Tonnage"), "Sum of Tonnage", xlSum
ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
'Find last row on Totals Pivot tab
PLR = ThisWorkbook.Worksheets("Totals Pivot").Cells(2, 1).End(xlDown).Row
'Copy/paste data to Totals Page tab
ThisWorkbook.Worksheets("Totals Page").Range("A2:D37").Value = ThisWorkbook.Worksheets("Totals Pivot").Range("A3:D" & PLR).Value
'Delete Grand Total from column A
With ThisWorkbook.Worksheets("Totals Page").Range("A2:A37")
.Replace what:="Grand Total", replacement:=""
End With
'Delete #N/A from column B
With ThisWorkbook.Worksheets("Totals Page").Range("B2:B37")
.Replace what:="#N/A", replacement:=""
End With
End Sub
Sub Summary_Pivot()
'Create Totals tab info using pivot table code below
ActiveWorkbook.Worksheets("Totals Pivot").PivotTables("PivotTable1").PivotCache.CreatePivotTable _
TableDestination:="'Summary Pivot'!R1C1", TableName:="PivotTable2", DefaultVersion _
:=xlPivotTableVersion14
Workbooks(mBook).Worksheets("Summary Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Location Code")
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = False
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Service Period")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Diversion Stream")
.Orientation = xlColumnField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("Tonnage"), "Sum of Tonnage", xlSum
ActiveSheet.PivotTables("PivotTable2").RowAxisLayout xlTabularRow
ActiveSheet.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels
ActiveSheet.PivotTables("PivotTable2").PivotFields("Diversion Stream"). _
CalculatedItems.Add "div %", "= SUM(RECYCLE )/(SUM(RECYCLE )+SUM(TRASH ))", _
True
'Replace nulls and errors with 0
ActiveSheet.PivotTables("PivotTable2").NullString = "0"
ActiveSheet.PivotTables("PivotTable2").DisplayErrorString = True
ActiveSheet.PivotTables("PivotTable2").ErrorString = "0"
End Sub
---------------------------------------------------------------------------------------------------------------
Now, when it goes back to the original code (below) it doesn't find the RECYCLE Total row to highlight it. While testing, I found that variable "I" doesn't obtain the row number of the RECYCLE Total row. The odd part (for me) is that it finds the TRASH Total row and highlights that one without any problems.
---------------------------------------------------------------------------------------------------------------
'Activate Diversion Detail tab
ThisWorkbook.Worksheets("Diversion Detail").Activate
'Add Subtotals
ThisWorkbook.Worksheets("Diversion Detail").Range("A3:W" & LR).Subtotal GroupBy:=12, Function:=xlSum, _
TotalList:=Array(18), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'Highlight and Bold Subtotal/Total rows if they exist
Dim DivWksht As Worksheet
Set DivWksht = ThisWorkbook.Worksheets("Diversion Detail")
Dim FoundCell1 As Range
Set FoundCell1 = DivWksht.Range("L:L").Find("RECYCLE Total", Range("L1"), xlValues, xlWhole, xlByColumns, xlNext)
If Not FoundCell1 Is Nothing Then
I = FoundCell1.Row
Else
'MsgBox "Still got a problem."
End If
If I = 0 Then
'do nada
Else
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).Interior.ThemeColor = xlThemeColorAccent2
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).Font.Bold = True
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).Font.ThemeColor = xlThemeColorDark1
ThisWorkbook.Worksheets("Diversion Detail").Range("A" & I & ":W" & I).NumberFormat = "_(#,##0.00_);_((#,##0.00);_("" - ""??_);_(@_)"
End If
Dim FoundCell2 As Range
Set FoundCell2 = DivWksht.Range("L:L").Find("TRASH Total", Range("L1"), xlValues, xlWhole, xlByColumns, xlNext)
If Not FoundCell2 Is Nothing Then
I = FoundCell2.Row
Else
'MsgBox "Still got a problem."
End If
If I = 0 Then
'do nada
Else
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).Interior.ThemeColor = xlThemeColorAccent2
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).Font.Bold = True
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).Font.ThemeColor = xlThemeColorDark1
ThisWorkbook.Sheets("Diversion Detail").Range("A" & I & ":W" & I + 1).NumberFormat = "_(#,##0.00_);_((#,##0.00);_("" - ""??_);_(@_)"
End If
----------------------------------------------------------------------------------------------------------------
There is more code after this but the only issue is the non highlighting of the RECYCLE Total row.
