Saturday, November 14, 2015

Excel VBA Macro to Copy Specific Slides from One Presentation to Multiple Presentations

How to Copy Specific Slides from One PowerPoint Presentation to other Multiple Presentations with VBA Macro :
The following Macro example copies the specific Slides from source Presentation and Pasting at the specified Slide Index in the Target Presentations...

Sub Copy_Slides_from_One_to_Multiple_Presentations()
    Dim New_PowerPoint As Object
    Dim Src_PPT As PowerPoint.Presentation
    Dim Tgt_PPT As PowerPoint.Presentation
    
    Alert = MsgBox("The Macro will Merge Slides from Source Presentation to Multiple Target                     Presentations ", vbOKCancel, "Please Confirm to Go / Cancel")

    If Alert = vbCancel Then Exit Sub

    Set Run_Tab = ThisWorkbook.Sheets("Run_Process")
    Set CPanel_Tab = ThisWorkbook.Sheets("CPanel")
   
    Src_PPT_Path = CPanel_Tab.Range("D22").Value
    Tgt_PPT_Path = CPanel_Tab.Range("D25").Value
    Src_PPT_Name = "My_Source_Presentation_*.ppt*"
       
    Set New_PowerPoint = Nothing
    On Error Resume Next
    Set New_PowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
 '<< Check whether a PPT Application is Open if open Close and open a New Application >>
        If New_PowerPoint Is Nothing Then
                     Set New_PowerPoint = New PowerPoint.Application
                     New_PowerPoint.Visible = msoCTrue
                     New_PowerPoint.DisplayAlerts = False
           Else
                     New_PowerPoint.Quit
                     Set New_PowerPoint = New PowerPoint.Application
                     New_PowerPoint.Visible = msoCTrue
                     New_PowerPoint.DisplayAlerts = False
           On Error GoTo 0
        End If
        
   
    Src_PPT_File = Dir(Src_PPT_Path & "\" & Src_PPT_Name)
      
    Set Src_PPT = New_PowerPoint.Presentations.Open(Src_PPT_Path & "\" &                                                          Src_PPT_File)
    
        For X = 1 To 2
    
            If X = 1 Then
                    Tgt_PPT_Name = "Target-East_*.ppt*"
                    Tgt_PPT_File = Dir(Tgt_PPT_Path & "\" & Tgt_PPT_Name)
                    
                    Set Tgt_PPT = New_PowerPoint.Presentations.Open(Tgt_PPT_Path & "\" &                                                          Tgt_PPT_File)
                
                 'Activating the Source Presentation and Copying the Specific Slides
                    Src_PPT.Windows(1).Activate
                    Src_PPT.Slides.Range(Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)).Copy
                 
                 'Activating the Target Presentation and Pasting at/after Target Slide(Index) 
                    Tgt_PPT.Windows(1).Activate                                
                    Tgt_PPT.Slides.Paste Index:=10
                    Tgt_PPT.Save
                    Tgt_PPT.Close
                    
                ElseIf X = 2 Then
                    Tgt_PPT_Name = "Target-West_*.ppt*"
                    Tgt_PPT_File = Dir(Tgt_PPT_Path & "\" & Tgt_PPT_Name)
                    
                    Set Tgt_PPT = New_PowerPoint.Presentations.Open(Tgt_PPT_Path & "\" &                                                          Tgt_PPT_File)
                    
                'Activating the Source Presentation and Copying the Specific Slides
                    Src_PPT.Windows(1).Activate
                    Src_PPT.Slides.Range(Array(15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25)).Copy
                    
                 'Activating the Target Presentation and Pasting at/after Target Slide(Index)
                    Tgt_PPT.Windows(1).Activate
                    Tgt_PPT.Slides.Paste Index:=15                    
                    Tgt_PPT.Save
                    Tgt_PPT.Close
                  
            End If
            
        Next X
        
    Src_PPT.Close
    New_PowerPoint.Quit
    Set New_PowerPoint = Nothing
    Set Src_PPT = Nothing
    Set Tgt_PPT = Nothing
    
 MsgBox "Specific Slides from Source to Target Presentations Copied Successfully",  vbOKOnly, "Final Presentation Ready"
End Sub
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Saturday, October 31, 2015

How to Check and Create a Folder in VBA

How to Check whether a Folder Exists or Not in a Specific Path
Suppose If we want to Create a Folder with Name as "TestFolder" only if it does not exist in the Specified Path , we can use the Len function along with the IF Condition to check the Folder existence then we use the MkDir keyword to create a folder as per below

If Len(Dir("C:\Users\Tamatam\Desktop\Reports\TestFolder", vbDirectory)) = 0 Then
   
   MkDir "C:\Users\Tamatam\Desktop\Reports\TestFolder"

End If

Thanks,
TAMATAM

Sunday, September 27, 2015

How to Schedule, Call and Run a Macro from a Workbook

How to Schedule, Call and Run a Macro from a Workbook
When we want to run a Macro from an event or from another Macro in the same Workbook , We can call the Macro like this in code :
Call MyMacroName

But if we want to run a macro that is in another workbook or Add-In(File or add-in must be open). We can use Application.Run as follows :
Application.Run "MyWorkBook.xls!MyMacroName"

Case I : 
Suppose if the Workbook name is not known in advance and its dynamically declared in a variable then we call the Macro as follows :
Application.Run " '" & strFileName & "'!MyMacroName"

Case II :
Suppose if the Macro is specific to particular Worksheet Event , then we need to specify the Sheet name along with Macro name as follows :

Application.Run " '" & strFileName & "'!Sheet1.MyMacroName"

Please Note :
To get the Exact Macro name , we need to go to Macros in Excel Workbook where we can see all the Macros with Correct names to be use as reference for Calling/Running.

Scheduling the Macro :
There are many ways to schedule your macros to run using the Application.OnTime method. The most common ways are via specific times (03:00, 11:45, 19:30) or a time relative to the existing time.

Scheduling at a  Specific Time :
If a task must be run every day at the same time, it makes sense to apply the specific time technique. Let’s say you have to run a macro every day at 7am.

Application.OnTime TimeSerial (h, m, s) , "Module1.Morning7AM_Task_Macro"
Application.OnTime  "07:00:00", "Morning7AM_Task_Macro"

Note:
The time can passed as 24 hour format as well like "15:15:00" for 03:15 PM

Scheduling at Relative Times :
You can also schedule macros to run at relative times. The most common way is to schedule it relative to the current time. You would do this by using the Now function to grab the current time then adding some amount of time to it.
The DateAdd function is a good option if you want to add two times together, and it plays well with the Now function. The following code fires off the Macro after nseconds from now, where nseconds is determined by the user.

nseconds = CInt(InputBox("How many Seconds after from Now, the Macro should run?"))
Application.OnTime DateAdd("s", nseconds, Now), "Module1.Macro_to_Schedule"

Note :
It would be helpful if we specify the Module name in the Macro, so that no issue arises even if we have the Macros with the same name in different modules.

Scheduling Macros in Other Workbooks :
The  Application.OnTime method can be used to call and execute the Macros from  other open workbooks,by properly specifying the name of the other workbook. 

A call to a workbook named OtherWorkbook.xlsm with a Macro named MyMacro in it will look like this:
Application.OnTime "17:15:03", "OtherWorkbook.xlsm!Module1.MyMacro"

Scheduling Macros in Closed Workbooks :
Since the scheduling happens at the Application level, as long as the Application is open, the scheduled Macro should execute. A user can close all of the workbooks but leave the  Excel Application(from where we executing a Macro) running and it will be fine. In other words, all the workbooks can be closed but Excel must remain open for the OnTime method to operate.
To call a Macro in a closed workbook, we need to supply the full filepath to the workbook:

Application.OnTime Now + TimeSerial(3, 15, 5), "C:\WorkingFiles\Otherorkbook.xlsm!Module1.MyMacro"

Thanks, TAMATAM

Saturday, September 5, 2015

How to Update a Target Table by Mapping with another Table in SQL Server

SQL Query to Update a Target Table by Mapping with another Table in SQL Server
Suppose , we have a Target Table called 'Tbl_Customers', in which the columns [Cust_Segment] and [Bookings_Flag] are need to update by Mapping it with a another Table called 'Map_Table' . we can do it by using the Update query as follows..

With Inner Join :
UPDATE [Tbl_Customers]
SET [Cust_Segment] = M.[CustSegment],
[Bookings_Flag]= CASE When M.[Bookings_Type]='Product' Then 'Prod' ELSE 'Svc' END
From [Tbl_Customers] C Inner Join [Map_Table] M
On C.Cust_Id=M.CustId

With Where Clause :
UPDATE [Tbl_Customers]
SET [Cust_Segment] = M.[CustSegment],
[Bookings_Flag]= CASE When M.[Bookings_Type]='Product' Then 'Prod' ELSE 'Svc' END
From [Tbl_Customers] C, [Map_Table] M
Where C.Cust_Id=M.CustId


--------------------------------------------------------------------------------------------------------

Saturday, August 29, 2015

How to Copy Excel Range to PowerPoint Slide with Source Formatting as Editable Table

Excel VBA Macro to Copy Excel Range to PowerPoint Slide with Source Formatting as Editable Table

If we want to copy the Excel Range as a Editable Table Format to Power Point Slide , we need to use the " CommandBars.ExecuteMso ("PasteSourceFormatting") " method.

Sample Code :

Dim New_PPT As PowerPoint.Presentation
Dim PPT_Slide As PowerPoint.Slide

Set New_PowerPoint = New PowerPoint.Application
New_PowerPoint.Visible = msoCTrue 
    
New_PowerPoint.ActiveWindow.View.GotoSlide (PPT_No)

Set PPT_Slide = New_PowerPoint.ActivePresentation.Slides(PPT_No)

             MyRange.Copy
             New_PowerPoint.Activate
             PPT_Slide.Select
PPT_Slide.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")


Thanks ,TAMATAM

Sunday, July 26, 2015

How to Copy and Paste Excel Range as Picture in VBA

Excel VBA Macro to Copy an Excel Range as Picture and Pasting as Picture
Sub Copy_Paste_As_Picture()
'Method -I : Copying the Range as Picture and Pasting
'Selecting and Copying the Range
'ActiveSheet.Range(MyRange).Select

'Copying as Picture , Best Usage Method: This will copy the Range in Excel without Background
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Copying as Bit Map Image Method: This will copy the Range in Excel with Background
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

'Copying as Picture Print Method:
    Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture

    ThisWorkbook.Sheets("MyTab").Activate
    ActiveSheet.Range("A5").Select
    ActiveSheet.Paste
    
'Method - II : Copying the Range and Pasting as Picture
'Selecting and Copying the Range
ActiveSheet.Range(MyRange).Select
Selection.Copy

    ThisWorkbook.Sheets("MyTab").Activate
    ActiveSheet.Range("A5").Select

'Pasting as Picture
    ActiveSheet.Pictures.Paste
'Pasting as Picture with Source Link (The Source Tab & Range Address of the Image in Excel)
    ActiveSheet.Pictures.Paste(Link:=True).Select
    
End Sub
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Saturday, July 11, 2015

How to Loop through Named Ranges in Excel

VBA Macro to Loop through Named Ranges in Excel
Sub Loop_Names()

Dim MyRng As Name

For Each MyRng In ThisWorkbook.Names

If InStr(MyRng.Name, "My_PPT") Then
'Displaying Range Name
MsgBox MyRng.Name
'Displaying the Range Reference
MsgBox MyRng.RefersToRange.Address
'Displaying the Range existed Sheet Name
MsgBox MyRng.RefersToRange.Parent.Name
End If

Next MyRng

End Sub

Friday, July 10, 2015

How to Copy a Named Range as a Picture from Target Excel File

VBA Macro to Copy a Named Range as a Picture from Target Excel File
Sub Copy_Named_Range_As_Picture()
Dim WS As Worksheet
Dim Tgt_File As Object
Dim MyTab as Object
Dim CopyRange as Object

Dim Src_Path As String
Dim Src_File As String
Dim RngName As String

Dim Tgt_Sht As String
Dim This_WB As Workbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False
   
   Set This_WB = ThisWorkbook
   Set MyTab = This_WB.Sheets("Graphs")

   Src_Path = This_WB.Sheets("CPanel").Range("A10").Value & "\"
   Src_File_Name = "Regional_Sales*.xls*" 

'Opening the Target file from the specified source Path
   Src_File = Dir(Src_Path & Src_File_Name)
   Set Tgt_File = Workbooks.Open(Src_Path & Src_File, UpdateLinks:=False, ReadOnly:=True, Editable:=True)
    
        Application.Calculation = xlCalculationAutomatic   

'The Named Range which we want to Copy from Target Excel file.
            RngName = "Sales_Chart" 

'Defining the Target Named Range to Copy
            Set CopyRange = Tgt_File.Names(RngName).RefersToRange

'Getting Target Sheet name where the Named Range exists
            Tgt_Sht = Tgt_File.Names(RngName).RefersToRange.Parent.Name
            Tgt_File.Sheets(Tgt_Sht).Activate
            CopyRange.Select
            Selection.Copy
'Activating the Destination sheet and Pasting the copied Range as a Picture      
            MyTab.Activate
            ActiveSheet.Range("E5").Select
            ActiveSheet.Pictures.Paste.Select

Tgt_File.Activate
Tgt_File.Close

Set  CopyRange=Nothing
Set  This_WB=Nothing
Set   MyTab=Nothing

EndSub


--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

How to Resize or Delete the Picture Objects in Excel

VBA Macro to Resize or Delete the Picture Objects in Excel Activesheet
Sub Resize_Picture_Objects()
Dim WS As Worksheet

Set WS = ActiveSheet
Dim Obj As Object
On Error Resume Next

For Each Obj In WS.Pictures

Obj.Select

With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Width = 650
.ShapeRange.Height = 300
End With

Next Obj

Set WS = Nothing

End Sub
----------------------------------------------------------------------------------------------------------
To Delete the Picture Objects in Excel Activesheet:
Sub Delete_Picture_Objects()
Dim WS As Worksheet

Set WS = ActiveSheet
Dim Obj As Object
On Error Resume Next

For K = 1 To 2
For Each Obj In WS.Pictures

Obj.Delete

Next Obj
Next K

Set WS = Nothing

End Sub

Saturday, July 4, 2015

VBA Macro to Select Multiple Ranges in Excel

How to Select Multiple Ranges , Rows , Columns in Excel with VBA
Sub Select_Multi_Rows_Cols_Ranges()

Dim WS As Worksheet

Set WS = ActiveSheet

'Selecting a Row 5
WS.Rows(5).Select

'Selecting a Rows 5 to 10
WS.Rows("5:10").Select

'Selecting Multiple Rows 5,7,9
WS.Range("5:5,7:7,9:9").Select

'Selecting Multiple Rows 5,7,9 by their Range_Names
WS.Range("Row_5,Row_7,Row_9").Select

'Selecting a Column 2
WS.Columns(2).Select
WS.Columns("B:B").Select

'Selecting a Columns 1 to 3
WS.Columns("A:C").Select

'Selecting Multiple Columns 1,3,5
WS.Range("A:A,C:C,E:E").Select

'Selecting Multiple Columns 1,3,5 by their Range_Names
WS.Range("Col_1,Col_3,Col_5").Select

'Selecting Multiple Ranges <A1:C5>,<B6:D10>
WS.Range("A1:C5,B6:D10").Select

'Selecting Multiple Ranges by their Range_Names
WS.Range("Range_123,Range_345").Select

'Defining Multiple Ranges
Set Rng1 = WS.Range("A2:B5")
Set Rng2 = WS.Range("D2:E5")
Set Rng3 = WS.Range("G2:H5")

'Union all the Ranges
Set Multi_Range = Union(Rng1, Rng2, Rng3)
Multi_Range.Select
Selection.Copy

WS.Range("K2").Select
WS.Paste

'Some Pastespecial Methods
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

'Copy Pastes Method in Single Line
MyRng.Copy Destination:=Range("A2")
End Sub

Thanks,
TAMATAM

Saturday, June 27, 2015

VBA Macro to Loop through all Excel files in a Folder

How to Loop through all Excel[.xls] files in a Folder using VBA
 Sub Loop_Through_Xls_Files()
    Dim SourcePath As String
    Dim SourceFolder As Object
    Dim SrcFile As String
    Dim My_WB As Object
    
    Dim MyXlFiles() As String
    Dim FSO As Object
    Dim K As Integer
    
    Application.DisplayAlerts = False
    K = 1

'To Select the Target Folder by Opening the File Dialogue Box
   Set Flder_Picker = Application.FileDialog(msoFileDialogFolderPicker)
   
   With Flder_Picker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub 'Exit if we don't select a Folder
        MyPath = .SelectedItems(1) & "\"
    End With
  
  MsgBox MyPath

'Loop through each Excel File in the Target Folder and Storing in an Array
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    SourcePath = MyPath 
    Set SourceFolder = FSO.GetFolder(SourcePath)
          
    For Each File In SourceFolder.Files
    If InStr(File.Name, ".xls") Then
    
    ReDim Preserve MyXlFiles(K)
    MyXlFiles(K) = File.Name

    K = K + 1
    
    End If
    Next File
    
'Loop through specific Excel Files , Opening , Performing an Operation and Closing, from the SourcePath
    SrcFile = Dir(SourcePath & "SQL*.xls")
       
    Do While SrcFile <> ""               
        Set My_WB = Workbooks.Open(SourcePath & SrcFile, UpdateLinks:=False, ReadOnly:=True, Editable:=True)
         ' Your Macro operation here        
        MsgBox SrcFile 'My_WB.Name
        My_WB.Close
           
        SrcFile = Dir() 'Allows to Go to Next File in a Directory
    Loop
 End Sub

Thanks, TAMATAM

Sunday, June 21, 2015

Excel VBA Pivot Table Standard Operations

Pivot Table Standard Operations with Excel VBA
Suppose we have a Pivot Table as Follows :

Pivot Field list as follows :

On the above Pivot Table , we can perform various standard basic operations using VBA as follows :


Sub Pivot_Operations()

Dim Pvt As PivotTable
Dim Pvt_GrandTotal As Range

For Each Pvt In ActiveSheet.PivotTables

If Pvt.Name = "Pivot_Main" Then
Set MyPivot = ActiveSheet.PivotTables(Pvt.Name)
End If

Next Pvt
--------------------------------------------------------- 
'Setting the Grand Totals On for Columns and Rows
    With MyPivot
        .ColumnGrand = True
        .RowGrand = True
    End With
--------------------------------------------------------- 
'Changing the Pivot Layout to Classic Pivot Model , Displaying the FieldCaptions(Prod_Id, Sales_Period)

With MyPivot
    .InGridDropZones = True
    .DisplayFieldCaptions = True
    .RowAxisLayout xlTabularRow
End With

'Showing the Details of All data. The following method works good on Classic Pivot Tables , we can  convert a Pivot to Classic Pivot using above method.

Set Pvt_GrandTotal = MyPivot.GetPivotData("Sum of Sales")
Pvt_GrandTotal.ShowDetail = True
--------------------------------------------------------- 
'Showing the Details of All data. This method is not working properly(Getting Runtime Error 438)
MyPivot.DataBodyRange.Select
RC = (Selection.Rows.Count) - 1
CC = (Selection.Columns.Count) - 1

ActiveCell.Offset(RC, CC).Select
Selection.ShowDetails = True
--------------------------------------------------------- 
'Counting the PivotFields(ReportFilters,RowLabels,ColumnLabels)
PFC = MyPivot.PivotFields.Count

'Looping Thorough Pivot Fields ( Row Lables ,Report Filter, Column Labels , Values )
For X = 1 To PFC
'Displaying the Pivot Field Name
MsgBox MyPivot.PivotFields(X).Name

If MyPivot.PivotFields(X).Name = "Sales_Period" Then
'Counting the PivotItems of a Desired PivotField
PIC = MyPivot.PivotFields(X).PivotItems.Count

'Displaying the PivotFiled Orientation[Row Field(Orientaion=1),Column Field(Orientaion=2)]
MsgBox MyPivot.PivotFields(X).Orientation

'Looping through the specific Pivot Filed Items
For Y = 1 To PIC

'Checking whether the Desired Pivot Field is a Row Field/Column Field
If MyPivot.PivotFields(X).Orientation = xlRowField Then

'To Select the Specified Field Item Data Range
MyPivot.PivotFields("X").PivotItems(1).DataRange.Select
GT = (Selection.Cells.Count) + 1 'Count of Pivot Item Values

'Getting the Pivot < Row Field Item > and its Grand Total Value
MyPivot.PivotFields(X).PivotItems(Y).LabelRange.Select
MsgBox Selection.Value  'Pivot Item
MsgBox ActiveCell.Offset(0, GT).Value  'Grand Total of the Pivot Item

ElseIf MyPivot.PivotFields(X).Orientation = xlColumnField

'To Select the Specified Field Item Data Range
MyPivot.PivotFields("X").PivotItems(1).DataRange.Select
GT = (Selection.Cells.Count) + 1 'Count of Pivot Item Values

'Getting the Pivot < Colum Field Item > and its Grand Total Value
MyPivot.PivotFields(X).PivotItems(Y).LabelRange.Select
MsgBox Selection.Value 'Pivot Item
MsgBox ActiveCell.Offset(GT, 0).Value 'Grand Total of the Pivot Item

End If

Next Y

End If

Next X
--------------------------------------------------------- 
'To select the Report Filter
MyPivot.PageRange.Select

'To select the Cell of Sum of Sales/Net Sales.
MyPivot.DataLabelRange.Select

'To Select the Column/Row Header Label < Sales_Period >/<Prod_Id>
MyPivot.PivotFields("Sales_Period").LabelRange.Select

'To Select the Column/Row Label Items
MyPivot.PivotFields("Sales_Period").DataRange.Select

'To Select the Particular Field Item Label
MyPivot.PivotFields("Sales_Period").PivotItems("Q3-2014").LabelRange.Select

'To Select the Particular Field Item Data Range
MyPivot.PivotFields("Sales_Period").PivotItems("Q3-2014").DataRange.Select

'To Select the Row Grand Totals with Label < Grand Total >
MyPivot.PivotSelect "'Row Grand Total'", xlDataAndLabel, True

'To Select the Column Grand Totals with Label < Grand Total >
MyPivot.PivotSelect "'Column Grand Total'", xlDataAndLabel, True

'To Select the Intersection Value of Row and Column Item.
Intersect(MyPivot.PivotFields("Prod_Id").PivotItems("CDE_3456").DataRange.EntireRow, _
MyPivot.PivotFields("Sales_Period").PivotItems("Q3-2014").DataRange).Select

'To Select the Row Labels Range
MyPivot.RowRange.Select

'To Select the Column Labels Range
MyPivot.ColumnRange.Select

'To select the Data Section including Grand Totals.
MyPivot.DataBodyRange.Select
--------------------------------------------------------- 
'Applying Filter on Row/Column/Filter PivotFields
    With MyPivot.PivotFields("Prod_Id")
        .PivotItems("BCD_2345").Visible = False
        .PivotItems("DEF_4567").Visible = False
        .PivotItems("FGH_6789").Visible = False
        .PivotItems("GHI_7890").Visible = False
    End With

'Clearing Filters from Row/Column/Filter PivotFields
MyPivot.PivotFields("Prod_Id").ClearAllFilters
--------------------------------------------------------- 
'Changing the DataPivotField Caption
MyPivot.DataPivotField.PivotItems("Sum of Sales").Caption = "Net_Sales"

'Adding a < Row Field > to a Pivot
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Prod_Id")
        .Orientation = xlRowField
        .Position = 1
    End With

'Adding a < Column Field > to a Pivot
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales_Period")
        .Orientation = xlColumnField
        .Position = 1
    End With

'Adding a < Report Filter > to a Pivot
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales_Region")
        .Orientation = xlPageField
        .Position = 1
    End With

'Adding a Field in < Values Section > of a Pivot
    ActiveSheet.PivotTables("Pivot_Main").AddDataField ActiveSheet.PivotTables( _
        "Pivot_Main").PivotFields("Sales"), "Sum of Sales", xlSum
    
    ActiveSheet.PivotTables("Pivot_Main").AddDataField ActiveSheet.PivotTables( _
        "Pivot_Main").PivotFields("Sales_Region"), "Count of Sales_Region", xlCount

'Changing the Function of a Value Field in < Values Section > of a Pivot :
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales")
        .Orientation = xlDataField
        .Caption = "Count the Sales"
        .Function = xlCount
        .Position = 1
        .NumberFormat = "#,##0"
    End With

    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales")
        .Caption = "Sum of Sales"
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
    End With
---------------------------------------------------------   
'Removing the Grand Totals for Columns an Rows
MyPivot.ColumnGrand = False
MyPivot.RowGrand = False

'To Remove the <Net Sales>/<Sum of Sales>/Data Section along with Grand Totals
MyPivot.PivotFields("Net_Sales").Orientation = xlHidden


End Sub
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Featured Post from this Blog

How to compare Current Snapshot Data with Previous Snapshot in Power BI

How to Dynamically compare two Snapshots Data in Power BI Scenario: Suppose, we have a sample Sales data, which is stored with Monthly Snaps...

Popular Posts from this Blog