Pivot data range needs to be constant

balaji3081 · Sep 9, 2013

Hi,

Below is the Macro I run - To create a copy of the base file and to get the required data and deleting the rest, and refreshing the pivots, this work really great, thaks to debraj (excel Ninja).

Coming to the point - the new file created has three pivots , and the range it has is of the base file and not of the own file.....

Sub GetData()
With Sheets(1)
ParentDept = Left(.[G3], 4): dept = Left(.[G5], 4)
' fname = "\" & .[c3] & " - " & .[c5] & " - " & _
' MonthName(Format(Date, "m") - 1, True)
End With
Sheets.Copy
Set deb = ActiveWorkbook
With deb
For i = Sheets.Count To 2 Step -1
With Sheets(i)
Select Case .Name
Case "RDW - Actuals", "BUDGET - FY13-FPA", "FTE", "RDW LY Actuals"
Sheets(i).Select
Set hdr = .UsedRange.Find(What:="SUB- DEPT", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
With .UsedRange.Offset(1)
If Not Sheets(i).AutoFilterMode Then _
.AutoFilter
.Value = .Value
.AutoFilter hdr.Column, "="
.Offset(1).SpecialCells(12).EntireRow.Delete -4162
.AutoFilter
End With
End Select
End With
Next i
Sheets("Details").PivotTables("PivotTable6").RefreshTable
Sheets("FMNO Driven Expenses").PivotTables("PivotTable1").RefreshTable
Sheets("Project Driven Expenses").PivotTables("PivotTable2").RefreshTable
End With
MsgBox "File Ready! Please save.. "
End Sub

Sam Mathai Chacko · Sep 9, 2013

1. Can you clarify exactly what your question is
2. Please wrap codes with code tags (Code)Your code here(/Code) replace the parenthesis with square brackets []

balaji3081 · Sep 9, 2013

The Issue here is - The pivot is the new file carriers the range from the base file.

Code:

Sub GetData()
    With Sheets(1)
        ParentDept = Left(.[G3], 4): dept = Left(.[G5], 4)
'        fname = "\" & .[c3] & " - " & .[c5] & " - " & _
'            MonthName(Format(Date, "m") - 1, True)
    End With
    Sheets.Copy
    Set deb = ActiveWorkbook
    With deb
        For i = Sheets.Count To 2 Step -1
        With Sheets(i)
        Select Case .Name
            Case "RDW", "BUDGET - FY13-FPA", "RDW LY Actuals"
            Sheets(i).Select
            Set hdr = .UsedRange.Find(What:="SUB- DEPT", LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
              With .UsedRange.Offset(1)
                If Not Sheets(i).AutoFilterMode Then _
                    .AutoFilter
                    .Value = .Value
                    .AutoFilter hdr.Column, "="
                    .Offset(1).SpecialCells(12).EntireRow.Delete -4162
                    .AutoFilter
              End With
        End Select
        End With
        Next i
        Sheets("Details").PivotTables("PivotTable1").RefreshTable
        Sheets("FMNO Driven Expenses").PivotTables("PivotTable2").RefreshTable
        Sheets("Project Driven Expenses").PivotTables("PivotTable3").RefreshTable
    End With
    MsgBox "File Ready! Please save.. "
End Sub

Sam Mathai Chacko · Sep 9, 2013

This should do

Before Sheets.Copy, use something like this (I'm only taking one pivot table in to consideration, you can replicate it for others)

Code:

    Dim strSource1 As String
    strSource1 = Sheets("Details").PivotTables("PivotTable1").SourceData

and just after the Next i

Code:

Sheets("Details").PivotTables("PivotTable1").ChangePivotCache deb. _
    PivotCaches.Create(Source:=xlDatabase, SourceData:=strSource1, Version:=xlPivotTableVersion14)' Use 14 for Excel 2010 Or xlPivotTableVersion12 if you are using Excel 2007

balaji3081 · Sep 22, 2013

Hi Sam,
Sorry for the delayed one from my end, and Thanks for the reply.

I got the file from my partner for tis month, and tried with your code but again gives me a debug error.

Please help

Code:

ub GetData()
    With Sheets(1)
        ParentDept = Left(.[G3], 4): dept = Left(.[G5], 4)
'        fname = "\" & .[c3] & " - " & .[c5] & " - " & _
'            MonthName(Format(Date, "m") - 1, True)
    End With
    Dim strSource1 As String
    strSource1 = Sheets("Details").PivotTables("PivotTable6").SourceData
    Sheets.Copy
    Set deb = ActiveWorkbook
    With deb
        For i = Sheets.Count To 2 Step -1
        With Sheets(i)
        Select Case .Name
            Case "RDW - Actuals", "BUDGET - FY13-FPA", "FTE", "RDW LY Actuals"
            Sheets(i).Select
            Set hdr = .UsedRange.Find(What:="SUB- DEPT", LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
              With .UsedRange.Offset(1)
                If Not Sheets(i).AutoFilterMode Then _
                    .AutoFilter
                    .Value = .Value
                    .AutoFilter hdr.Column, "="
                    .Offset(1).SpecialCells(12).EntireRow.Delete -4162
                    .AutoFilter
              End With
        End Select
        End With
        Next i
        Sheets("Details").PivotTables("PivotTable6").ChangePivotCache deb. _
        PivotCaches.Create(Source:=xlDatabase, SourceData:=strSource1, Version:=xlPivotTableVersion14)
        Sheets("Details").PivotTables("PivotTable6").RefreshTable
        Sheets("FMNO Driven Expenses").PivotTables("PivotTable1").RefreshTable
        Sheets("Project Driven Expenses").PivotTables("PivotTable2").RefreshTable
    End With
    MsgBox "File Created! Please save.. "
End Sub

Sam Mathai Chacko · Sep 22, 2013

Please attach the files. Without that, it's difficult to diagnose.

balaji3081 · Sep 23, 2013

Hi Sam,

below is the link - https://docs.google.com/file/d/0B00CYZ_WSBc6aXVFczdIakV4WHc/edit?usp=sharing

Thanks,
Bala

NARAYANK991 · Sep 23, 2013

Hi Balaji ,

I am not aware of your original question , and Sam's answer ; I downloaded your file , and clicked on the Get Data button ; the macro ran to completion and gave a message at the end :

File Created ! Please save

Under what circumstances are you getting an error ?

Narayan

balaji3081 · Sep 23, 2013

Hi Narayan,

If you see the pivot table its linking to the the base file and not to the file the pivot is in....hence Sam gave the code (before and after), but if you insert Sam's macro in my file its giving an error......

Regards,
Bala

NARAYANK991 · Sep 23, 2013

Hi Balaji ,

Do you mean to say that I have to copy the macro from Sam's post into your file overwriting the existing GetData macro ?

Narayan

balaji3081 · Sep 23, 2013

You can try that.....

balaji3081 · Sep 23, 2013

Hi Narayan,

I tried using Sam code to solve the issue, however its not working and gives me a error, I have to manually change the Pivot range to the pivot file.

Regards,
Balaji

NARAYANK991 · Sep 23, 2013

Hi Balaji ,

Can you try this ?

Code:

Sub GetData()
    With Sheets(1)
        ParentDept = Left(.[G3], 4): dept = Left(.[G5], 4)
'        fname = "\" & .[c3] & " - " & .[c5] & " - " & _
'            MonthName(Format(Date, "m") - 1, True)
    End With
    Dim strSource1 As String
    strSource1 = R1C1converter(Sheets("Details").PivotTables("PivotTable6").SourceData)
   
    sheet_name1 = Mid(strSource1, InStr(1, strSource1, "]") + 1)
    sheet_name = Left(sheet_name1, InStr(1, sheet_name1, "!") - 2)
    Range_name = Right(sheet_name1, InStr(1, sheet_name1, "!") - 1)
   
    Sheets.Copy
    Set deb = ActiveWorkbook
   
    With deb
        For i = Sheets.Count To 2 Step -1
        With Sheets(i)
        Select Case .Name
            Case "RDW - Actuals", "BUDGET - FY13-FPA", "FTE", "RDW LY Actuals"
            Sheets(i).Select
            Set hdr = .UsedRange.Find(What:="SUB- DEPT", LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
              With .UsedRange.Offset(1)
                If Not Sheets(i).AutoFilterMode Then _
                    .AutoFilter
                    .Value = .Value
                    .AutoFilter hdr.Column, "="
                    .Offset(1).SpecialCells(12).EntireRow.Delete -4162
                    .AutoFilter
              End With
        End Select
        End With
        Next i
       
        deb.Activate
        Sheets("Details").Select
        With ActiveSheet
            .PivotTables("PivotTable6").ChangePivotCache ActiveWorkbook. _
            PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:="'" & sheet_name & "'!" & Range_name)
        End With
       
        Sheets("Details").PivotTables("PivotTable6").RefreshTable
        Sheets("FMNO Driven Expenses").PivotTables("PivotTable1").RefreshTable
        Sheets("Project Driven Expenses").PivotTables("PivotTable2").RefreshTable
    End With
    MsgBox "File Created! Please save.. "
End Sub

Narayan

balaji3081 · Sep 23, 2013

Hi Narayan,

It give me a Compile error as : Sub or function not defined

Highlighting 'R1C1converter' from the code.

Regards,
Bala

NARAYANK991 · Sep 23, 2013

Hi Balaji ,

Sorry. Please copy it :

Code:

Function R1C1converter(Address As String, Optional R1C1_output As Integer, Optional RefCell As Range) As String
    'Converts input address to either A1 or R1C1 style reference relative to RefCell
    'If R1C1_output is xlR1C1, then result is R1C1 style reference.
    'If R1C1_output is xlA1 (or missing), then return A1 style reference.
    'If RefCell is missing, then the address is relative to the active cell
    'If there is an error in conversion, the function returns the input Address string
    Dim x As Variant
    If RefCell Is Nothing Then Set RefCell = ActiveCell
    If R1C1_output = xlR1C1 Then
        x = Application.ConvertFormula(Address, xlA1, xlR1C1, , RefCell) 'Convert A1 to R1C1
    Else
        x = Application.ConvertFormula(Address, xlR1C1, xlA1, , RefCell) 'Convert R1C1 to A1
    End If
    If IsError(x) Then
        R1C1converter = Address
    Else
       
        'If input address is A1 reference and A1 is requested output, then Application.ConvertFormula
        'surrounds the address in single quotes.
        If Right(x, 1) = "'" Then
            R1C1converter = Mid(x, 2, Len(x) - 2)
        Else
            R1C1converter = x
        End If
    End If
End Function

I got it from here :

http://www.vbaexpress.com/kb/getarticle.php?kb_id=254

Narayan

balaji3081 · Sep 23, 2013

Hey Narayan, I am still not sure where to copy it...sorry for the trouble.....

Sam Mathai Chacko · Sep 23, 2013

balaji, you need to copy it to a code module. Insert a new code module in your VBA project by going to the VBE window.

Sam Mathai Chacko · Sep 23, 2013

By the way, here's another attempt at your original macro

Code:

Sub GetData()
 
    Dim strSource1 As String, deb As Workbook
    With Sheets(1)
        ParentDept = Left(.[G3], 4): dept = Left(.[G5], 4)
'        fname = "\" & .[c3] & " - " & .[c5] & " - " & _
'            MonthName(Format(Date, "m") - 1, True)
    End With
    strSource1 = Sheets("Details").PivotTables("PivotTable6").SourceData
    Sheets.Copy
    Set deb = ActiveWorkbook
    With deb
        For i = Sheets.Count To 2 Step -1
            With Sheets(i)
                Select Case .Name
                    Case "RDW - Actuals", "BUDGET - FY13-FPA", "FTE", "RDW LY Actuals"
                        Sheets(i).Select
                        Set hdr = .UsedRange.Find(What:="SUB- DEPT", LookIn:=xlValues, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
                        With .UsedRange.Offset(1)
                          If Not Sheets(i).AutoFilterMode Then _
                              .AutoFilter
                              .Value = .Value
                              .AutoFilter hdr.Column, "="
                              .Offset(1).SpecialCells(12).EntireRow.Delete -4162
                              .AutoFilter
                        End With
                End Select
            End With
        Next i
        Sheets("Details").PivotTables("PivotTable6").ChangePivotCache deb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=GetRangeFromRCRefStyle(strSource1).Address(1, 1, xlR1C1, True), Version:=xlPivotTableVersion12)
        deb.RefreshAll
    End With
    MsgBox "File Created! Please save.. "
   
End Sub
 
Function GetRangeFromRCRefStyle(strReference As String) As Range
 
    Dim var As Variant
    Dim wks As Worksheet
    Dim str As String
    var = Split(strReference, "!")
    If UBound(var) Then
        Set wks = Worksheets(Replace(var(0), "'", ""))
        str = Application.ConvertFormula(var(1), xlR1C1, xlA1, True, wks.Cells(1))
        Set GetRangeFromRCRefStyle = wks.Range(str)
    Else
        str = Application.ConvertFormula(var(0), xlR1C1, xlA1, True, ActiveSheet.Cells(1))
        Set GetRangeFromRCRefStyle = Range(str)
    End If
   
End Function

NARAYANK991 · Sep 24, 2013

Hi Balaji ,

If you wish , you can download your file , and check whether the macro works.

https://www.dropbox.com/s/3rubpao1elv0z4o/Data for macro (Balaji).xlsm

Narayan

balaji3081 · Sep 24, 2013

Hi Sam/Narayan,

Thanks for all your effort and time, this is working great, and the pivots are now using the excat range.

Thanks again.
Regards,
Balaji

Pivot data range needs to be constant

Member

Active Member

Member

Active Member

Member

Active Member

Member

Excel Ninja

Member

Excel Ninja

Member

Member

Excel Ninja

Member

Excel Ninja

Member

Active Member

Attachments

Active Member

Excel Ninja

Member