Macro to Filter Pivot Table not working when the Value does not exist

[Mavericks334]

Hi,

Below is my macro that i use to Create a sheet if the sheet does not exist and the copy the data and paste it. Then the macro goes to the pivot table sheet and copies all the information according to the filter.

After the sheet is created and even if there is no data the macro check for the pivot table inform (This code could be improved).

Since there is no pivot table data it gives me an error. When i create a condition to skip the copy if there is not data and avoid creating a sheet.

I get an error when i go to the next sheet to repeat the process.

' Hold Reqs Update<o></o>
On Error Resume Next<o></o>
sh = Sheets("Hold Reqs").Name<o></o>
On Error GoTo 0<o></o>
If sh <> "" Then<o></o>
Sheets(sh).Activate<o></o>
Else<o></o>
Worksheets.Add.Name = "Hold Reqs"<o></o>
End If <o></o>
Sheets("Hold Reqs").Select<o></o>
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2<o></o>
Range("A1").Select<o></o>
Range(Selection, Selection.End(xlToRight)).Select<o></o>
Range(Selection, Selection.End(xlDown)).Select<o></o>
Selection.ClearContents<o></o>
Lw = Range("A" & Rows.Count).End(xlUp).Row<o></o>
Range("Y2").Select<o></o>
Range("Y2:Z2" & Lw).Select<o></o>
Range(Selection, Selection.End(xlDown)).Select<o></o>
Selection.ClearContents<o></o>
Windows("FTS_HC").Activate<o></o>
Sheets("HR").Select<o></o>
Lw = Range("A" & Rows.Count).End(xlUp).Row<o></o>
<o> </o>
Range("A1").Select<o></o>
Range("A1").AutoFilter Field:=25, Criteria1:= _<o></o>
"IO"<o></o>
Range("A1:W" & Lw).Select<o></o>
Range(Selection, Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
Windows(fname).Activate<o></o>
Sheets("Hold Reqs").Select<o></o>
Range("A1").Select<o></o>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _<o></o>
:=False, Transpose:=False <o></o>
Windows("FTS_HC").Activate<o></o>
Sheets("Pivot_HR").Select <o></o>
ActiveSheet.PivotTables("PivotTable4").PivotFields("Function"). _<o></o>
ClearAllFilters<o></o>
ActiveSheet.PivotTables("PivotTable4").PivotFields("Sub_function"). _<o></o>
ClearAllFilters<o></o>
ActiveSheet.PivotTables("PivotTable3").PivotFields("Function").CurrentPage = _<o></o>
"IO"<o></o>
Lw = Range("a" & Rows.Count).End(xlUp).Row<o></o>
<o> </o>
Range("a6").Select<o></o>
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Dept ID")<o></o>
.PivotItems("(blank)").Visible = False<o></o>
End With <o></o>
Range("a6").Select<o></o>
Range("a6:b" & Lw).Select<o></o>
Range(Selection, Selection.End(xlDown)).Select<o></o>
Selection.Copy<o></o>
Windows(fname).Activate<o></o>
Range("Y2").Select<o></o>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _<o></o>
:=False, Transpose:=False<o></o>
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1<o></o>
Rows("1:1").Select<o></o>
For Each ws In ActiveWorkbook.Worksheets<o></o>
Application.DisplayAlerts = False<o></o>
If LenB(ActiveSheet.Range("A2")) = 0 Then ActiveSheet.Delete<o></o>
Application.DisplayAlerts = True<o></o>
Next ws<o></o>
' Transfer in Update<o></o>
On Error Resume Next<o></o>
sh = Sheets("Transfers In").Name<o></o>
On Error GoTo 0<o></o>
If sh <> "" Then<o></o>
Sheets(sh).Activate<o></o>
Else<o></o>
Worksheets.Add.Name = "Transfers In"<o></o>
End If


The grey areas are where the error occurs if i say on Error resume next the send grey area the sheet name does not change.

 

[sijpie]

Unfortunately there are no grey areas in your posted code. Also please use code tags around your code (in advanced reply there is a code tag button with a #, or just type [code ] your code here [/code]
.

Anyway I'll see if I can replicate your problem, meanwhile you can clear up your code no end. Yu don't need to select ranges to do something with them. When you record a macro that is what Excel gives you, but then normally you can delete the words 'select' and 'selection' and marry them together:

Sub pt()
    ' Hold Reqs Update
    On Error Resume Next
    sh = Sheets("Hold Reqs").Name
    On Error GoTo 0
    If sh = "" Then
        Worksheets.Add.Name = "Hold Reqs"
    End If
    Sheets(sh).Activate
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
    Range("A1").CurrentRegion.ClearContents
    Lw = Range("A" & Rows.Count).End(xlUp).Row
    ' your code is very confusing in the nextr few rows.
    ' I think you meant the following"
    Range("Y2:Z" & Lw).ClearContents
    
    Windows("FTS_HC").Activate
    Sheets("HR").Select
    Lw = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("A1").AutoFilter Field:=25, Criteria1:="IO"
    Range("A1:W" & Lw).Copy
    Windows(fname).Activate
    Sheets(sh).Select
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Windows("FTS_HC").Activate
    With Sheets("Pivot_HR")
        .PivotTables("PivotTable4").PivotFields("Function"). _
            ClearAllFilters
        .PivotTables("PivotTable4").PivotFields("Sub_function"). _
            ClearAllFilters
        .PivotTables("PivotTable3").PivotFields("Function").CurrentPage = _
            "IO"
        Lw = .Range("a" & Rows.Count).End(xlUp).Row
    
        .PivotTables("PivotTable4").PivotFields ("Dept ID")
        .PivotItems("(blank)").Visible = False
        .Range("a6:b" & Lw).Resize(.Range("a6:b" & Lw).End(xlDown)).Copy


    End With
    Windows(fname).Activate
    Range("Y2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
    Rows("1:1").Select
    For Each ws In ActiveWorkbook.Worksheets
        Application.DisplayAlerts = False
            If LenB(ActiveSheet.Range("A2")) = 0 Then ws.Delete
        Application.DisplayAlerts = True
    Next ws
    ' Transfer in Update
    On Error Resume Next
    sh = Sheets("Transfers In").Name
    On Error GoTo 0
    If sh <> "" Then
        Sheets(sh).Activate
        Else
        Worksheets.Add.Name = "Transfers In"
    End If

It can stillbe cleaned up a lot more, but we'll come to that later I think.

There was one big mistake in your delete sheet loop: you were deleting the activesheet rather than the sheet where A2 =0

See if my code does what is supposed to happen.

 

[Mavericks334]

Hi Sijpie,

I tried the code i still get the error. I understand my code is a bit confusing and it can be improved. Please find the tags that explains what is happening. The error msg that i get is mentioned if i can get that to work and then go to the next worksheet and repeating the same process would be great.

'Macro checks to see if the sheet is existing and if it does skips the sheet and if it does not creates a work sheet
On Error Resume Next<O:P></O:P>
sh = Sheets("Hold Reqs").Name<O:P></O:P>
On Error GoTo 0<O:P></O:P>
If sh <> "" Then<O:P></O:P>
Sheets(sh).Activate<O:P></O:P>
Else<O:P></O:P>
Worksheets.Add.Name = "Hold Reqs"<O:P></O:P>
End If

'Macro Selects the Worksheet if it already exists and clears the existing contents

Sheets("Hold Reqs").Select
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Lw = Range("A" & Rows.Count).End(xlUp).Row
' This two colums sum the data by each id.
Range("Y2").Select
Range("Y2:Z2" & Lw).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

' Macro goes to the raw data tab and filters by specific department & copies the information. If the information for the department is blank it still copies the sheet


Windows("FTS_HC").Activate
Sheets("HR").Select
Lw = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
Range("A1").AutoFilter Field:=25, Criteria1:= _
"IO"
Range("A1:W" & Lw).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

' Macro goes to the report file and pastes the copied data

Windows(Fname).Activate
Sheets("Hold Reqs").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Macro goes to the sheet where the pivot table is avaiable and filters information by the department and copies and pastes in the report file from column Y


indows("FTS_HC").Activate
Sheets("Pivot_HR").Select

ActiveSheet.PivotTables("PivotTable4").PivotFields("Function"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Sub_function"). _
ClearAllFilters
' Problem starts here since there if there is no information for the particular department b
ActiveSheet.PivotTables("PivotTable4").PivotFields("Function").CurrentPage = _
"IO"
" Error Msg: Application defined error or objective defined error."

'Because of which the code does not work.

Lw = Range("a" & Rows.Count).End(xlUp).Row
Range("a6").Select
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Dept ID")
.PivotItems("(blank)").Visible = False
End With

 

[sijpie]

Mavericks, please use code tags around your code (in advanced reply there is a code tag button with a #, or just type [code ] your code here [/code].

You are not a newbie here, so you should know better. Else I will stop replying

 

[Mavericks334]

Hi Sijpie,
I Apologize, i never knew how to do it until you explained it to me.

 [FONT=Segoe UI][FONT=Segoe UI][COLOR=#000000][SIZE=3][COLOR=#000000][FONT=Calibri]'Macro checks to see if the sheet is existing and if it does skips the sheet and if it does not creates a work sheet
On Error Resume Next<O:P></O:P>
[FONT=Calibri]sh = Sheets("Hold Reqs").Name<O:P></O:P>[/FONT][/FONT]
[FONT=Calibri]On Error GoTo 0<O:P></O:P>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]If sh <> "" Then<O:P></O:P>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]Sheets(sh).Activate<O:P></O:P>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]Else<O:P></O:P>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]Worksheets.Add.Name = "Hold Reqs"<O:P></O:P>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]End If 

'Macro Selects the Worksheet if it already exists and clears the existing contents

Sheets("Hold Reqs").Select
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Lw = Range("A" & Rows.Count).End(xlUp).Row
' This two colums sum the data by each id.
Range("Y2").Select
Range("Y2:Z2" & Lw).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

' Macro goes to the raw data tab and filters by specific department & copies the information. If the information for the department is blank it still copies the sheet


Windows("FTS_HC").Activate
Sheets("HR").Select
Lw = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
Range("A1").AutoFilter Field:=25, Criteria1:= _
"IO"
Range("A1:W" & Lw).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

' Macro goes to the report file and pastes the copied data

Windows(Fname).Activate
Sheets("Hold Reqs").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Macro goes to the sheet where the pivot table is avaiable and filters information by the department and copies and pastes in the report file from column Y


indows("FTS_HC").Activate
Sheets("Pivot_HR").Select

ActiveSheet.PivotTables("PivotTable4").PivotFields("Function"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Sub_function"). _
ClearAllFilters
' Problem starts here since there if there is no information for the particular department b 
[B]ActiveSheet.PivotTables("PivotTable4").PivotFields("Function").CurrentPage = _
"IO"
[/B]" Error Msg: Application defined error or objective defined error."

'Because of which the code does not work.

Lw = Range("a" & Rows.Count).End(xlUp).Row
Range("a6").Select
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Dept ID")
.PivotItems("(blank)").Visible = False
End With [/FONT][/COLOR][/SIZE] [/COLOR][/FONT][/FONT]

 

[sijpie]

The problem that you notice starts at the pivot table. But your problem really starts earlier because your code is so all over the place. If you make a cleaner more logical code, then it will also be far easier to debug.

Look at this section here and check line for line what it is doing:

1   Sheets("Hold Reqs").Select
2   ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
3   Range("A1").Select
4   Range(Selection, Selection.End(xlToRight)).Select
5   Range(Selection, Selection.End(xlDown)).Select
6   Selection.ClearContents
7   Lw = Range("A" & Rows.Count).End(xlUp).Row
' This two colums sum the data by each id.
8   Range("Y2").Select
9   Range("Y2:Z2" & Lw).Select
10  Range(Selection, Selection.End(xlDown)).Select
11  Selection.ClearContents

in line 1 you select a sheet. Earlier you had already assigned the name off the sheet to 'sh', so continue to use this variable. If ever later you need to make a change, you only need to make it in one place.
Also in line 1, you do not need to select the sheet. Just use the sheet in line 2, instead of activesheet.
in line 2 you expand any column outlines.

Lines 3,4,5,6 can be replaced by one simple statement: Range("A1").CurrentRegion.ClearContents. Again no need to select anything. (Selecting is really slow in Excel!)

In line 7 you want to get the last row with value in column A. But you just cleared column A completely! So the value will be 1. So no need to do this.

Line 8 is also superfluous, as you don't do anything with the select, in line 9 you select another range. Get rid of old code when you amend your code.

In Line 9 you do something which is not really what you want, but you probably didn't notice that, as you were lucky. What you are saying is: Take range (Y2:Z21) (yes: Z21) and extend it downward till the end. Then clear it.
So which range do you really want to clear? I am assuming it will be range Y2: Z(end down). Which means that the Lw is not required at all. So not only did you do difficult things in line 7 totally unnecessary, but you don't even need Lw.
So then lines 8,9,10 & 11 can again be written much easier:
Range("Y2").Resize(Range("Y" & Rows.Count).End(xlUp).Row - 1, 2).ClearContents


So now we can write this little section as:

With Sheets(sh)
        .Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
        .Range("A1").CurrentRegion.ClearContents
        .Range("Y2").Resize(Range("Y" & Rows.Count).End(xlUp).Row - 1, 2).ClearContents
    End With

So only three lines!
It is better tohave the ranges here refer to sheets (sh) as well, as we are swapping files and sheets. Also you lose track of where you are.

 

[Mavericks334]

Thanks for the feedback. How could i change the pivot error. As it effects the rest of the code. I have made the necessary changes and still encounter the error when the code tries to filter the pivot and criteria is not met.

 

[sijpie]

OK further cleaning up and optimisation:
Because we are referring to several workbooks and sheets, it is better to set some variables to these items, to keep better track of where we are, and as mentioned above, to avoid having to go through tons of code if you ever decide to change the name of a sheet, or reuse this code in another sheet.

The same may be useful for ranges.As far as I can decifer, there are two workbooks and three sheets:

Sub test()
    Dim sName As String, lRw As Long
    Dim wbFNm As Workbook, wbFTS As Workbook
    Dim wsHoldReq As Worksheet, wsHR As Worksheet, wsPivHR As Worksheet
    Dim wsTrans As Worksheet
    Const csWSNM = "Hold Reqs"


    On Error Resume Next
    Set wbFNm = Workbooks("FName")
    Set wbFTS = Workbooks("FTS_HC")
    On Error GoTo 0
    If wbFNm Is Nothing Or wbFTS Is Nothing Then
        MsgBox "Both workbooks FName and FTS_HR need to be open"
        Exit Sub
    End If
    On Error Resume Next
    Set wsHoldReq = wbFNm.Sheets(csWSNM)
    On Error GoTo 0
    If wsHoldReq Is Nothing Then
    wbFNm.Worksheets.Add.Name = csWSNM
'   'this is now the active sheet, so we assign wsholdreq to it
    Set wsHoldReq = ActiveSheet
    
    Set wsPivHR = wbFTS.Sheets("Pivot_HR")
    Set wsHR = wbFTS.Sheets("HR")
    
    'Prepare sheet Hold Reqs
    With wsHoldReq
        .Range("Y2").Resize(Range("Y" & Rows.Count).End(xlUp).Row - 1, 2).ClearContents


        .Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
        .Range("A1").CurrentRegion.ClearContents
        .Range("Y2").Resize(Range("Y" & Rows.Count).End(xlUp).Row - 1, 2).ClearContents
    End With
    
    With wsHR
        Lw = .Range("A" & Rows.Count).End(xlUp).Row
    
        .Range("A1").AutoFilter Field:=25, Criteria1:="IO"
        .Range("A1:W" & Lw).Copy
    End With
    With wsHoldReq
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    
    End With
    With wsPivHR
        .PivotTables("PivotTable4").PivotFields("Function"). _
            ClearAllFilters
        .PivotTables("PivotTable4").PivotFields("Sub_function"). _
            ClearAllFilters
        .PivotTables("PivotTable3").PivotFields("Function").CurrentPage = "IO"
        Lw = .Range("a" & Rows.Count).End(xlUp).Row
    
        .PivotTables("PivotTable4").PivotFields ("Dept ID")
        .PivotItems("(blank)").Visible = False
        .Range("a6:b" & Lw).Resize(.Range("a6:b" & Lw).End(xlDown)).Copy
    End With
    With wsHoldReq
        .Range("Y2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        .Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
    End With
    For Each WS In wbFNm.Worksheets
        Application.DisplayAlerts = False
            If LenB(ActiveSheet.Range("A2")) = 0 Then WS.Delete
        Application.DisplayAlerts = True
    Next WS
    ' Transfer in Update
    On Error Resume Next
    Set wsTrans = Sheets("Transfers In")
    On Error GoTo 0
    If wsTrans Is Nothing Then
        wbFNm.Worksheets.Add.Name = "Transfers In"
        Set wsTrans = ActiveSheet
    End If
    wsTrans.Activate
End Sub

This still won't solve the issue of your missing pivot data, but that will have to come next

 

[sijpie]

Thanks for the feedback. How could i change the pivot error. As it effects the rest of the code. I have made the necessary changes and still encounter the error when the code tries to filter the pivot and criteria is not met.

If you comment out this one pivot request, does the rest of the new code run OK?

 

[Mavericks334]

Yes it does work fine. I removed the pivot error by defining a different variable for each sheet. However how could i avoid the error by using a generic variable.