Posts by Mattador

Mattador · Feb 6th 2017

Re: Cost Centre Project, Add Loop Funcionality, £60 GBP

OK that will be fine.

Though review for feasibility before you do any work on the project. I wan to give you the opportunity to feedback before you start working.

Cheers

Matt

Mattador · Feb 5th 2017

Hi

I have a excel VBA project with limited annonmised data for working draft purposes, please see attached.

What I have

My Project currently does the following:

Raw data is download from the Accounting ledger and added to the blue tabs
On the purple tabs a report is collated based on sumif's from the raw data. The criteria are in cell A6 "Cost Centre & CellA10 "Period"._ Sheet"CC Rep".
There is a pivottable on sheet"Line Item". This has selction change code on the sheet so that the pivot table updates from cell C9 "period" & Cell C10 Cost Centre.
There are two macro buttons on sheet"CC REP", the first copies the report on this tab to a new worksheet and renames it, the second takes the pivot table in sheet"Detail" and creates to new sheets. One a values only copy of the pivottable and the other the drilldown detail of that pivot table.

What I need

This works just fine, what i need help in doing is the following:

There are about 56 Cost Centres that this needs repeating for. It is time consuming and labourious. I tried to automate with a loop, but he output was 56 reports all correctly named showing the same data.
Also I could not get teach cost centre to produce the three reports from one macro?

What i would like is as follows:

My VBA adapting with explanations (I need to understnad this and takeownership)
All three reports can run off one button
There is the added function to produce all 56 Cost centre reports from one loop function, showing the correct data for each report.
The splitwork book macro to pick up only the report sheets
The pivottable drill down detail sheet to be formated as £100.00

Code/ macros used

Copy Report
Copy Detail
Selection change code to update pivot
Delete Reports
Split workbook

UpdatePivot

Code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  
'This line stops the worksheet updating on every change, it only updates when cell
'C9 or C10 is touched
If Intersect(Target, Range("C9:C10")) Is Nothing Then Exit Sub
 
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat1 As String
Dim NewCat2 As String
 
Set ws = Sheets("Line item")
'Here you amend to suit your data
'Assigning the Pivot table fields to variables already declared
Set pt = ws.PivotTables("PivotTable1")
Set Field1 = pt.PivotFields("Cost Ctr")
Set Field2 = pt.PivotFields("Per")


'Linking values inputted in the front end to variables
'Cost Centre
NewCat1 = ws.Range("C10").Value
'Period
NewCat2 = ws.Range("C9").Value
 
 'This updates and refreshes the PIVOT table
 
 
 'With Loop
With pt
Field1.ClearAllFilters
'Assigns the newcat1 variable(user defined)to the pivot filter
Field1.CurrentPage = NewCat1
Field2.ClearAllFilters
Field2.CurrentPage = NewCat2
pt.RefreshTable
End With
  
End Sub

Display More

Delete Sheets Code

Code

Sub Deletesheets_Report()
'To delete sheets out of report
Dim Col As Integer
Application.ScreenUpdating = False
For i = Sheets.Count - 1 To 2 Step -1
         
         'see if the sheet name contains a pipe symbol, if yes do nothing, if yes delete the sheet
         
        If InStr(Sheets(i).Name, " R ") > 0 Then
             
             'delete the sheet
             Application.DisplayAlerts = False
             Sheets(i).Delete
             Application.DisplayAlerts = True
             
        End If
         
   Next
   
   
 Sheets("CC REP").Select
 
   
End Sub
 
 Sub Deletesheets_Detail()
'To delete sheets out of report
Dim Col As Integer
Application.ScreenUpdating = False
For i = Sheets.Count - 1 To 2 Step -1
         
         'see if the sheet name contains a pipe symbol, if yes do nothing, if yes delete the sheet
         
        If InStr(Sheets(i).Name, " Det ") > 0 Then
             
             'delete the sheet
             Application.DisplayAlerts = False
             Sheets(i).Delete
             Application.DisplayAlerts = True
             
        End If
         
   Next
   
   
 Sheets("CC REP").Select
 
   
End Sub
 
 Sub Deletesheets_DrillD()
'To delete sheets out of report
Dim Col As Integer
Application.ScreenUpdating = False
For i = Sheets.Count - 1 To 2 Step -1
         
         'see if the sheet name contains a pipe symbol, if yes do nothing, if yes delete the sheet
         
        If InStr(Sheets(i).Name, " Drl ") > 0 Then
             
             'delete the sheet
             Application.DisplayAlerts = False
             Sheets(i).Delete
             Application.DisplayAlerts = True
             
        End If
         
   Next
   
   
 Sheets("CC REP").Select
 
   
End Sub

Display More

Copy sheets code

Code

Sub Copysheet_Report()
    Dim MyDate As String
    Dim cc As Range
    
   
    
    MyDate = Format(Now, "mm-ss")
   
    
    ActiveWorkbook.RefreshAll
 
    Set cc = Sheets("CC REP").Range("A6")
    
    Sheets("CC REP").Copy After:=Sheets("CC REP")
    Sheets("CC REP (2)").Name = cc & " R " & MyDate


        With Sheets(cc & " R " & MyDate)
    
            .Unprotect
            .Cells.Copy
            .Cells.PasteSpecial xlValues
            .Range("$AP$2:$AP$218").AutoFilter Field:=1, Criteria1:="Show"
        End With
        
Range("A6").Select
SendKeys "{ESC}", True
Sheets("CC REP").Activate
End Sub


Sub Copysheet_Detail()
    
    Call trigger_Pivotrefresh
    Call Drill_on_pivot_andsavesheet
    
    Dim MyDate As String
    Dim cc As Range
    
    MyDate = Format(Now, "mm-ss")
    '
    
    Set cc = Sheets("Line Item").Range("B10")
    
    Sheets("Line Item").Copy After:=Sheets("Line Item")
    Sheets("Line Item (2)").Name = cc & " Det " & MyDate


        With Sheets(cc & " Det " & MyDate)
    
            .Unprotect
            .Cells.Copy
            .Cells.PasteSpecial xlValues
            
            'To set to 2pd, not working???
            '.UsedRange.Columns(5).NumberFormat = "#,##0.00"
            
            '.Columns("E:E").NumberFormat = "#,##0"
           
            '.Range("$AP$2:$AP$218").AutoFilter Field:=1, Criteria1:="Show"
        End With
        
       
        
        
Range("B10").Select
SendKeys "{ESC}", True
Sheets("CC REP").Activate
End Sub
 Sub trigger_Pivotrefresh()
 
 Sheets("Line item").Select
 Range("C10").Select
 Range("C9").Select
 'Sheet3.Activate
 End Sub

Display More

Pivotdrill Code

Code

Sub Drill_on_pivot_andsavesheet()


    
    Dim cc                    As Long
    'Dim per                  As Long
    Dim pt                    As PivotTable
    Dim ws As Worksheet
    
    Set ws = Sheets("Line item")


    'Need to rename the drilldown sheet when created
    cc = ws.Range("C10").Value
    'peri = ws.Range("H6").Value
    
    On Error Resume Next
    'Assigning the Pivot table fields to cell values
    Set pt = ws.PivotTables("PivotTable1")
    'This updates and refreshes the pivot table
    With pt.PivotFields("Cost Ctr")
        .ClearAllFilters
        .CurrentPage = ws.Range("C10").Value
    End With
    With pt.PivotFields("Per")
        .ClearAllFilters
        .CurrentPage = ws.Range("C9").Value
    End With
    pt.RefreshTable
    
    'Active cell now replaced with last row of pivot table to make dynamic
    'ActiveCell.ShowDetail = True
    pt.DataBodyRange.Cells(pt.DataBodyRange.Cells.Count).ShowDetail = True
    
    On Error GoTo 0
    
    If ActiveSheet.Index <> ws.Index Then
        ActiveSheet.Name = cc & " Drl " & Format(Now, "mm-ss")
        ActiveSheet.Move After:=ws
        Cells(1).Select
        Sheet14.Activate
    End If
End Sub

Display More

Split work book Code

Code

Sub Splitbook()


Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 


For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xls"
    Application.ActiveWorkbook.Close False
    
Next


Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

Display More

To clarify

I must be able to follow, so will need explanation of code
Would prefer my code adapting to work in a loop
Must give corect data for each report.

Let me know your thoughts before jumping in an doing any work as I want to be fair.

Matt

forum.ozgrid.com/index.php?attachment/71253/

Mattador · Feb 1st 2017

Hi,

I have some code that will automatically create the drill down data on multiple pivot tables and extract the data to separate sheets.

This is gonig to be put in a loop and done for multiple reports, hence not manually clicking into the drill down field.

My question is as follows:

I want to auto format each sheet as it is created so that the currency values in a specific column are formated to 2dp .i.e. '199,88.22'.

I have tried the following code, but ih no effect

Code

.Columns("E:E").NumberFormat = "#,##0"

.

Can anyone correct this code?

Full code below:

Code

Sub Copysheet_Detail()
    
    Call trigger_Pivotrefresh
    Call Drill_on_pivot_andsavesheet
    
    Dim MyDate As String
    Dim cc As Range
    
    MyDate = Format(Now, "mm-ss")
    '
    
    Set cc = Sheets("Line Item").Range("B10")
    


    Sheets("Line Item").Copy After:=Sheets("Line Item")
    Sheets("Line Item (2)").Name = cc & " Det " & MyDate




        With Sheets(cc & " Det " & MyDate)
    
            .Unprotect
            .Cells.Copy
            .Cells.PasteSpecial xlValues
            
            'To set to 2pd, not working???
            '.Columns("E:E").NumberFormat = "#,##0"
           
            '.Range("$AP$2:$AP$218").AutoFilter Field:=1, Criteria1:="Show"
        End With
        
       


        
        
Range("B10").Select
SendKeys "{ESC}", True
Sheets("CC REP").Activate


End Sub

Display More

Thanks in advance

Mattador · Jan 31st 2017

Re: Automatically pick up showdetail field of pivot table, £5

Perfect works as requested.

Funds transferred, let me know if not received.

Matt

Mattador · Jan 31st 2017

Re: Automatically pick up showdetail field of pivot table, £5

Hi,

I think we are missing each others point.

To help find common understanding I will change how I explain my position.

To help I have attached a fresh work book with illustrated notes and a screen shot for visual reference.

Screen Shot

[ATTACH=CONFIG]71219[/ATTACH]

forum.ozgrid.com/index.php?attachment/71220/

As the cell highlighted red will move up and down depending on the number of Gl codes in a cost centre I need code that automatically selects the grandtotal drilldown field.

I thought I had communicated this clearly, obviuosly not. If you feel this is moving the goal posts then let me know and we can come to some amicable arrangement.

Thanks

Matt

Mattador · Jan 30th 2017

Re: Automatically pick up showdetail field of pivot table, £5

Yes, but it only works if the bottom cell is manually selected.

Mattador · Jan 30th 2017

Re: Automatically pick up showdetail field of pivot table, £5

It's not in the mock up i sent you.
If you want me to send a live file I will have to get some data from work and clense it/ tyle over, so that it has nothing confidential in.

If you need this it i can't access the data until tomorrow night.
That said it could be any pivot table where the row changes and the column is fixed.

Mattador · Jan 30th 2017

Re: Automatically pick up showdetail field of pivot table, £5

My pivot will be as follows:

Filtered by cost centre and month
Columns = Total
Rows = Account codes

As different cost centres have different activity the number of rows in each cost centre and hence length of pivot table will constantly change.

That will be the only dynamic variable.

Hope this clarifies.

Mattador · Jan 30th 2017

Re: Automatically pick up showdetail field of pivot table, £5

Hi,

This does not really do what I am asking, because I will not be able to automate the selection.

In this model column E will always have the pivot table total that I wish to drill into, the row however will change.
I tried to use the offset function to pick up the grand total in the pivot table and return the correct cell, but could not get it to work.

Does this make sense and is what I am asking feasible?

Mattador · Jan 30th 2017

Re: Automatically pick up showdetail field of pivot table, £5

forum.ozgrid.com/index.php?attachment/71213/

Hi,

Not sure I follows that plus it crashes when I run it.

I have attahced a owrking file that does what I want, except for picking up the end of a pivot table.

The relevant tab is report detail and the vba is in module 2.

The other stuff you can igonre.

Thanks
Matt

Mattador · Jan 30th 2017

Re: Automatically pick up showdetail field of pivot table, £5

Quote from Wigi;784527

Hello, I will do this one for you.

Agreed and thanks.

Mattador · Jan 30th 2017

Hi

I have the below VBA that works with a pivottable of a fixed number of rows.

What i need is code that will allow drilldown, show detail cell to be selected on a pivot table of any length.
Currently the VBA is set to cell "I33".

I am assuming that this is a relatively common vba request

Code

Sub Drill_on_pivot_andCopy()


    Dim cc                    As Long
    Dim pt                    As PivotTable




    
    cc = Sheets("Line Item").Range("B10").Value
  
 


    pt.RefreshTable


    
    
    Sheets("Line Item").Range("I33").ShowDetail = True
    ActiveSheet.Name = cc & " Drl " & Format(Now, "mm-ss")
    ActiveSheet.Move After:=Sheets("Line Item")
    Cells(1).Select
    Sheet14.Activate


End Sub

Display More

Thanks

Matt

Mattador · Jan 29th 2017

Re: VBA, Will not run, £20, GBP or Euro

Not a problem.

Will rewiew.

Thanks

Mattador · Jan 29th 2017

Re: VBA, Pivot Show Detail, Create to the right not the left

Perfect, thanks.

Mattador · Jan 28th 2017

Hi,

I have some VBA to automate the pivot drill down as part of a larger VBA project and I was hoping for some guidance.

Essnetially the code works, but it creates sheets to the left of the original pivottable and I want to create sheets gonig to the right.

The code, and it does work is as follows:

Code

Sub Drill_on_pivot()


    Dim cc                    As Long
    Dim peri                  As Long
    Dim pt                    As PivotTable




    
    cc = Sheet1.Range("H5").Value
    peri = Sheet1.Range("H6").Value
    
    


    On Error Resume Next


    'Assigning the Pivot table fields to cell values
    Set pt = Sheet1.PivotTables("PivotTable1")


    'This updates and refreshes the pivot table
    With pt.PivotFields("Cost Centre")
        .ClearAllFilters
        .CurrentPage = Sheet1.Range("H5").Value
    End With


    With pt.PivotFields("Period")
        .ClearAllFilters
        .CurrentPage = Sheet1.Range("H6").Value
    End With


    pt.RefreshTable


    On Error GoTo 0
    
    Sheet1.Range("E9").ShowDetail = True
    ActiveSheet.Name = cc & " | " & Format(Now, "mm-ss")
    Cells(1).Select
    Sheet1.Activate


End Sub

Display More

I think I just need to add something to get it to output to the right.

Hopefully this is very simple and I appreciate your help.

Thanks

Matt

Mattador · Jan 28th 2017

Re: VBA, Will not run, £20, GBP or Euro

Hi,

This doe not work correctly.
When I run the VBA I just get the same report copied repeatedly which is what my code did.

Please can you review and advise.

Thanks

Mattador · Jan 28th 2017

Re: VBA, Pivot Drill Down, Should be simple £5

Hi,

This works as requested.

Thanks

Matt

Mattador · Jan 23rd 2017

Re: VBA, Pivot Drill Down, Should be simple £5

Hi Wigi,

Had a tough day at work.

I will review tomorrow and double check that i paid you corrrectly.

Thanks in advance

Matt

Mattador · Jan 22nd 2017

Re: VBA, Will not run, £20, GBP or Euro

Still not received file.

Payment was sent.

Please confirm if there is a problem?

Matt

Mattador · Jan 22nd 2017

Re: VBA, Will not run, £20, GBP or Euro

Hi,

Yes new sheets created not to have macro buttons.

Thanks

Matt