Wednesday, 30 January 2013

How to Find First Occurrence of a String Based On Multiple Criteria

Excel VBA Macro To Know First Occurrence of a String Based On Multiple Criteria
Example Criteria:
'Suppose If You Have a Data with Ranges as 'ID','Start_Date','Week','Month','End_Date'
'And You Want to find the End_Date[Dead Line] for an ID with Week='Sunday' or 'Monday'
'And This Week Should be the First Occurred week and Should occur only once for the Same ID With Month Names as 'JAN' or 'FEB' or 'MARCH', In Such Cases..................... 
This Macro Will Help You.

'Dynamic Multi-Purpose Macro'
Sub MultiCrit_FirstOccur_Macro()
Dim X As Long
Dim Y As Long
Dim Z As Long

Dim I As Long

Dim J As Long
Dim K As Long
Dim LB As Long
Dim UB As Long

Dim A As Long

Dim B As Long

'My Sample Ranges

Dim ID As Object
Dim Week As Object
Dim Month As Object
Dim Start_Date As Object
Dim End_Date As Object
Dim Code As Object

Dim MaxDate As String

Dim MinDate As Date
Dim WSF As WorksheetFunction
Dim MyDate() As Date
Dim TempStr As Date
'-------------------------------------------------------
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'-------------------------------------------------------
Dim RC As Long 'All Rows Count
Dim CC As Long 'All Columns Count
Dim NBRC_Main As Long 'Non Blank Rows Count In Main[Data] Sheet
Dim NBRC_Sub As Long 'Non Blank Rows Count In Sub[Result] Sheet

RC = ThisWorkbook.ActiveSheet.Rows.Count

CC = ThisWorkbook.ActiveSheet.Columns.Count
'-------------------------------------------------------
'Defining Column Headers As List/Range Names for Each Column In Main Sheet
On Error Resume Next
ThisWorkbook.Sheets("Data").Activate
For X = 1 To 50
If ThisWorkbook.Sheets("Data").Cells(1, X) <> "" Then Cells(1, X).EntireColumn.Select
Selection.Name = Cells(1, X).value
Next X
'-------------------------------------------------------
'Defining Dynamic Ragne Names
Set ID = ThisWorkbook.Names("ID").RefersToRange.Cells
Set Start_Date = ThisWorkbook.Names("Start_Date").RefersToRange.Cells
Set End_Date = ThisWorkbook.Names("End_Date").RefersToRange.Cells
Set Month = ThisWorkbook.Names("Month").RefersToRange.Cells
Set Week = ThisWorkbook.Names("Week").RefersToRange.Cells
Set Code = ThisWorkbook.Names("Code").RefersToRange.Cells
'---------------------------------------------------------------------------------
Z = 0
For X = 2 To RC 
If ThisWorkbook.Sheets("Result").Cells(X, 1).value <> "" Then
ReDim MyDate(Z)
For Y = 2 To RC

'Criteria:
'My ID should match to an ID in a Range - ID
'My Month shoud Match to any of 3[JAN or FEB or MARCH] Months of a Range - Month

If ThisWorkbook.Sheets("Result").Cells(X, 1).value = ID.Rows(Y).value And (Month.Rows(Y).value = "JAN" _Or Month.Rows(Y).value = "MAR" Or _

Month.Rows(Y).value = "FEB") Then
'If The Above Criteria Matches Then Store Corresponding Strat_Date Values In Array
MyDate(Z) = Start_Date.Rows(Y).value
Z = Z + 1
'Reintializing Array Size
ReDim Preserve MyDate(Z)
End If
Next Y

End If

'---------------------------------------
'Sorting Date Values Stored In An Array to Know Earliest/First Occurance Date
LB = LBound(MyDate)
UB = UBound(MyDate)
    For I = LB To UB - 1
        For J = I + 1 To UB
            If MyDate(I) > MyDate(J) Then
                TempStr = MyDate(J)
                MyDate(J) = MyDate(I)
                MyDate(I) = TempStr
            End If
        Next J
    Next I
    
MinDate = MyDate(LBound(MyDate) + 1) 'Minimu Date Value Stored In An Array
'---------------------------------------
If ThisWorkbook.Sheets("Result").Cells(X, 1).value <> "" Then
'Minimum Corresponding Date Of the Matched Criteria
ThisWorkbook.Sheets("Result").Cells(X, 2).value = MyDate(LBound(MyDate) + 1)
'Maximum Corresponding Date Of the Matched Criteria
ThisWorkbook.Sheets("Result").Cells(X, 3).value = MyDate(UBound(MyDate))
End If
'---------------------------------------
'Again Looping to Check another Criteria In My Matched Criteria
K = 0
For A = 1 To RC
'Criteria:
'My ID should match to an ID in a Range - ID
'My Week shoud Match to any of 2[Sunday or Monday ] Weeks of a Range - Week
'And  The Week either 'Sunday' or 'Monday' Should Exist For one ID only once

If (ThisWorkbook.Sheets("Result").Cells(X, 1).value = ID.Rows(A).value) And _

(Week.Rows(A).value = "Sunday" Or Week.Rows(A).value = "Monday") Then
K = K + 1 'Count The Matched Criteria Which Should Be 0> and <=2
End If
Next A
'Loop to check whether the Week - 'Sunday' or 'Monday' for the Same ID Occured First and only once.
For B = 1 To RC
If (K <> 0) And (K <= 2) Then
If (ThisWorkbook.Sheets("Result").Cells(X, 1).value = ID.Rows(B).value) And _
(Start_Date.Rows(B).value = MinDate) And (Week.Rows(B).value = "Sunday" Or Week.Rows(B).value = "Monday") Then
ThisWorkbook.Sheets("Result").Cells(X, 4).value = K
ThisWorkbook.Sheets("Result").Cells(X, 5).value = End_Date.Rows(B).value
End If
End If
Next B
Z = 0
Next X

'---------------------------------------------------------------------------------
Application.DisplayAlerts = True
ThisWorkbook.Sheets("Result").Activate
End Sub

Thanks.,
TAMATAM

Monday, 28 January 2013

How To Find Difference of Maximum and Minimum Dates Using Arrays in Excel VBA

Excel VBA Macro To Find Difference of Maximum and Minimum Dates Using Array
Option Explicit
Sub Arrayz_Dates()
Dim X As Long
Dim Y As Long
Dim Z As Long

Dim I As Long

Dim J As Long
Dim K As Long
Dim LB As Long
Dim UB As Long

Dim Start_Date As Range

Dim End_Date As Range
Dim Max_Start_Date As Range
Dim Min_Start_Date As Range
Dim Difference As Range

Dim MyDate() As Date

Dim TempStr As String

Dim RC As Long 'All Rows Count

Dim CC As Long 'All Columns Count

RC = ThisWorkbook.ActiveSheet.Rows.Count
CC = ThisWorkbook.ActiveSheet.Columns.Count

Set Start_Date = ThisWorkbook.Names("Start_Date").RefersToRange.Cells

Set End_Date = ThisWorkbook.Names("End_Date").RefersToRange.Cells
Set Max_Start_Date = ThisWorkbook.Names("Max_Start_Date").RefersToRange.Cells
Set Min_Start_Date = ThisWorkbook.Names("Min_Start_Date").RefersToRange.Cells
Set Difference = ThisWorkbook.Names("Difference").RefersToRange.Cells
'-------------------------------------------------------------------------------------------------------
Z = 0
' Looping Through Checking Multiple Criteria In  List/Range Names'
For X = 2 To RC 'Youcan Use RC[All Rows Count] But Macro Becomes Very Slow
If Start_Date.Rows(X).value <> "" Then
Z = Z + 1
'Reintializing Array Size
ReDim Preserve MyDate(Z)
MyDate(Z) = Start_Date.Rows(X).value
End If
Next X
'-------------------------------------------------------------------------------------------------------
'Sorting Values Stored In An Array
LB = LBound(MyDate)

UB = UBound(MyDate)
    For I = LB To UB - 1
        For J = I + 1 To UB
            If MyDate(I) > MyDate(J) Then
                TempStr = MyDate(J)
                MyDate(J) = MyDate(I)
                MyDate(I) = TempStr
            End If
        Next J
    Next I
Max_Start_Date.Rows(2).value = MyDate(UBound(MyDate))
Min_Start_Date.Rows(2).value = MyDate(LBound(MyDate) + 1)
Difference.Rows(2).value = MyDate(UBound(MyDate)) - MyDate(LBound(MyDate) + 1)
End Sub
'-------------------------------------------------------------------------------------------------------

Thanks,
TAMATAM


Sunday, 27 January 2013

Excel VBA Dynamic Multipurpose Macro

Excel VBA Dynamic Multi-Purpose Macro
The Following is a Most Powerful and Dynamic Macro can be used in a efficient manner for various criteria.
Features of This Macro:
> This Macro Defines List/Range Names for Each Column with Column heading as List Name.
>These List Names we can use as dynamic ranges.
>This Macro Filter the Unique Records based on I-Column['ID'] of the Main Sheet and Copy those Unique Records to Sub Sheet ,We can use these Unique records for our criteria building.
>This macro dynamically full fill your requirement based on criteria builded by you.
>The macro is builded in a new and very dynamic approach.

Sub DynamicMacro()

Dim X As Long
Dim Y As Long
Dim Z As Long

Dim I As Long

Dim J As Long
Dim LB As Long
Dim UB As Long

'My Sample Ranges

Dim ID As Range
Dim Product As Range
Dim Division As Range
Dim Start_Time As Range
Dim Action As Range

Dim MaxDate As String

Dim MinDate As String
Dim WSF As WorksheetFunction
Dim MyDate() As Date
Dim TempStr As Date
'-------------------------------------------------------
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'-------------------------------------------------------
Dim RC As Long 'All Rows Count
Dim CC As Long 'All Columns Count
Dim NBRC_Main As Long 'For Non Blank Rows Count In Main[Data] Sheet
Dim NBRC_Sub As Long 'For Non Blank Rows Count In Sub[Result] Sheet

RC = ThisWorkbook.ActiveSheet.Rows.Count

CC = ThisWorkbook.ActiveSheet.Columns.Count
'-------------------------------------------------------
'Defining Column Headers As List/Range Names for Each Column In Main Sheet
On Error Resume Next
ThisWorkbook.Sheets("Main").Activate
For X = 1 To CC
If ThisWorkbook.Sheets("Main").Cells(1, X) <> "" Then Cells(1, X).EntireColumn.Select
Selection.Name = Cells(1, X).value
Next X
'-------------------------------------------------------
'Defining Dynamic Ragne Names
Set ID = ThisWorkbook.Names("ID").RefersToRange.Cells
Set Start_Date = ThisWorkbook.Names("Start_Date").RefersToRange.Cells
Set End_Date = ThisWorkbook.Names("End_Date").RefersToRange.Cells
Set Division = ThisWorkbook.Names("Division").RefersToRange.Cells
Set Product = ThisWorkbook.Names("Product").RefersToRange.Cells
Set Units = ThisWorkbook.Names("Units").RefersToRange.Cells
Set Price = ThisWorkbook.Names("Price").RefersToRange.Cells
Set Revenue = ThisWorkbook.Names("Revenue").RefersToRange.Cells
'-------------------------------------------------------
'Filtering Data In Main Sheet By ID , Copy Unique ID's and Paste In I-Column of Sub Sheet
ThisWorkbook.Sheets("Main").Activate
ActiveSheet.Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("ID").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ActiveSheet.Columns("A:A").Select
Selection.Copy
ThisWorkbook.Sheets("Sub").Activate
ActiveSheet.Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Range("A1").Select
ThisWorkbook.Sheets("Main").Activate
ActiveSheet.Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Selection.AutoFilter
'-------------------------------------------------------
'Non Blank Rows Count to Use in our Loops to Reduce Loop TAT [Turn Around Time]
For X = 1 To RC
If ThisWorkbook.Sheets("Main").Cells(X, 1) <> "" Then
NBRC_Main = NBRC_Main + 1 'Non Blank Rows Count Based I-Column In Main Sheet
End If
If ThisWorkbook.Sheets("Sub").Cells(X, 1) <> "" Then
NBRC_Sub = NBRC_Sub + 1 'Non Blank Rows Count Based I-Column In Sub Sheet
End If
Next X
'--------------------------------------------------------------------------------------------
' Looping Through Checking Multiple Criteria In  List/Range Names'
For X = 2 To NBRC_Sub 'Youcan Use RC[All Rows Count] But Macro Becomes Very Slow
ReDim MyDate(0)
If ThisWorkbook.Sheets("Sub").Cells(X, 1).value <> "" Then
For Y = 2 To NBRC_Main
If ThisWorkbook.Sheets("Sub").Cells(X, 1).value = ID.Rows(Y).value _
And (Division.Rows(Y).value = "String" Or Division.Rows(Y).value = "Electronic") And _
Product.Rows(Y).value = "Keyboard" Then
ThisWorkbook.Sheets("Sub").Cells(X, 3).value = ThisWorkbook.Sheets("Sub").Cells(X, 3).value + Units.Rows(Y).value

'Reintializing Array Size

MyDate(Z) = Start_Date.Rows(Y).value
Z = Z + 1
'Reintializing Array Size
ReDim Preserve MyDate(Z)
ThisWorkbook.Sheets("Sub").Cells(X, 2).value = Z
End If
Next Y
End If
'-------------------------------------------------------
'Sorting Values Stored In An Array
LB = LBound(MyDate)
UB = UBound(MyDate)
    For I = LB To UB - 1
        For J = I + 1 To UB
            If MyDate(I) > MyDate(J) Then
                TempStr = MyDate(J)
                MyDate(J) = MyDate(I)
                MyDate(I) = TempStr
            End If
        Next J
    Next I
'-------------------------------------------------------
ThisWorkbook.Sheets("Sub").Cells(X, 4).value = MyDate(UBound(MyDate)) 'Maximum Date Value Stored In An Array
ThisWorkbook.Sheets("Sub").Cells(X, 5).value = MyDate(LBound(MyDate) + 1) 'Minimum Date Value Stored In An Array
Z = 0
Next X
'--------------------------------------------------------------------------------------------
Application.DisplayAlerts = True
ThisWorkbook.Sheets("Sub").Activate
End Sub

Thanks.,
TAMATAM
     [ BI-Reporting Analyst ]

Wednesday, 23 January 2013

Excel Function to Find First and Latest Occurrence of an Action Date Value based on Condition

How to Find First and Latest Occurrence of an Action Date Value based on Condition
Suppose we have a data of  Students and their actions like Reading , Writing , Drawing by date as follows :


If you wants to find the First  and Latest occurrence dates of a student " Will Smith" Action 'Writing' , you can find in the following way.

First Occurrence :
 {=MIN(IF(($A$2:$A$20="Will Smith")*($B$2:$B$20="Writing")*($C$2:$C$20),($C$2:$C$20)))}

Latest Occurrence : 
Method - I :
 {=MAX(IF(($A$2:$A$20="Will Smith")*($B$2:$B$20="Writing")*($C$2:$C$20),($C$2:$C$20)))}

Method - II :
{=INDEX(C1:C20,MATCH(MAX(IF((A1:A20="John")*(B1:B20="Drawing"),(C1:C20),)),C1:C20,0),1)}




In the same we can Find the Maximum of Occurrence date of any of Two actions of Particular student , using the below formula :

{=INDEX(C1:C20,MATCH(MAX(IF((($A$1:$A$20="Will Smith")*OR($B$1:$B$20="Reading",$B$1:$B$20="Writing")),($C$1:$C$20),)),$C$1:$C$20,0),1)}


Thanks,
TAMATAM

Tuesday, 22 January 2013

How To Open a Dialog Box to Select a File and Copy Desired Columns

Excel VBA Macro To Open a Dialog Box to Select a File and Copy  Desired Columns which Match with our Workbook Columns


Sub CopyDesiredCols()
Dim TargetFile As Variant
Dim TargetFileName As Variant
Dim Ws As Worksheet
Dim X As Long
Dim Y As Long
Dim Z As Long

Y = ActiveSheet.Columns.Count

TargetFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm", , "Select Your File")

'If TargetFile = False Then Exit Sub

Workbooks.Open (TargetFile)
TargetFileName = ActiveWorkbook.Name
Workbooks(TargetFileName).Activate

For X = 2 To Y
If ThisWorkbook.Sheets("Mydata").Cells(1, X) <> "" Then

For Z = 2 To Y
If LCase(ThisWorkbook.Sheets("Mydata").Cells(1, X)) = LCase(ActiveWorkbook.Sheets("Database").Cells(1, Z)) Then
ActiveWorkbook.Sheets("Database").Cells(1, Z).EntireColumn.Select
Selection.Copy
ThisWorkbook.Sheets("Mydata").Cells(1, X).PasteSpecial Paste:=xlPasteValues
End If
Next Z

End If
Next X

Workbooks(TargetFileName).Save
Workbooks(TargetFileName).Close
MsgBox "DATA Succesfull Copied From " & " " & TargetFileName & vbNewLine _
& "You Can Select Next File", vbInformation, "Success !!!"
Exit Sub
'------------------------------------------------------------------------------------------'
TPR:
MsgBox Err.Description
End Sub

Thanks.,
T P REDDY
     [Excel Macro Man ]

Monday, 21 January 2013

How to Get Unique Values From A Range of Values Using CountIf Function

How to Get Unique Values From A Range of Values
Suppose we have a list of values with duplicates in Column A as shown below.


Now if you want to extract the unique values in Column B , we have to use the below formula.

Formula:

{=INDEX($A$2:$A$50,MATCH(0,COUNTIF($B$1:B1,$A$2:$A$50),0))}

Explanation:

Here $A$2:$A$50 is the range from which we want to extract unique values
Here we are extracting the unique values to Column B So that we should add this formula in Cell B2 , and drag it down.
This is a array based formula so that we should press Ctrl+Shift+Enter to work this formula.
#N/A will shown in the cells if the distinct values are over in the Range.

Thanks

TAMATAM

Sunday, 20 January 2013

How Transpose Data From Rows to Columns in Excel

How to Transpose Data From Rows to Columns and Vice Versa
How to Move data between rows and columns
Key Steps:
  1. Copy the data in one or more columns or rows.
  2. Before you paste the copied data, right-click your first destination cell (the first cell of the row or column into which you want to paste your data), and then click Paste Special.
  3. In the Paste Special dialog box, select Transpose, and then click OK.
  4. You'll find the Transpose check box in the lower-right corner of the dialog box



Output :




Regards.,

TAMATAM
  

How to Convert Column Headings as List Names or Range Names with Excel VBA Macro

Excel VBA Macro To Create List Names  or Range Names with Column Headings as they refers List Names for Respective Columns
Sub ColHeaderAsList()
Dim X As Long
Dim Y As Long
On Error Resume Next
Y = ActiveSheet.Columns.Count

For X = 1 To Y    'You can reduce this loop size as you wish
If Cells(1, X) <> "" Then Cells(1, X).EntireColumn.Select
Selection.Name = Cells(1, X).value
Next X

MsgBox "List Names are Created With Columns Headings", , "Successfull !!!"
End Sub

Example:

Sample Data



Output :
List Names / Range Names






Regards,
TAMATAM


How To Create Dynamic Drop Down List In Excel

How to Get Dynamic Range in DropDown List in Excel
Suppose you want create a dynamic drop list based on column where the values are dynamically changing , we have to follow the below method.
Key Steps:
  1. Click Data tab
  2. Click Data validation button
  3. Click "Data validation..."
  4. Select List in the "Allow:"
  5. Type =OFFSET($A$1,0,0,COUNTA($A:$A),1) In the "Source:" window
  6. Click OK!  



Example:
We have data as follows :



Now will add some more data is updated In Column A then the 
Drop Down List also Updated Dynamically. as Shown Below
This list may allows Duplicate Values also.



Thanks,
TAMATAM

Friday, 18 January 2013

How To Update Main Workbook Data Sheets With Respective Sheets Data of Sub Workbook

Excel VBA Macro To Update Main Workbook Data Sheets With Respective Sheets Data of Sub Workbook.
'How does this Macros Works:
'Suppose: -
'The Main[This Workbook]workbook has the following Sheets In Some Jumble Order -
'Rawdata,SalesbyCountry,Sheet1,Sheet3,Sheet2,SalebyCustomer,PivotData,,,Sheet4,
'The Sub[Selected Workbook]workbook has the following Sheets In Some Jumble Order -
'Rawdata,Sheet1,PivotData,Sheet2.
'Now the Macro will update the data in Worksheets of the Main workbook which are Match 'with the Names of the Subworkbook.
'i.e., The Sheets-'Rawdata,Sheet1,PivotData,Sheet2' of Main workbook only will update.

Sub UpdateRespectiveSheets()
Dim MyFile As Variant
Dim MyFileName As String
Dim Ws As Worksheet
Dim SheetIndex As Integer

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error GoTo TPR:
SheetIndex = 1
MyFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")
Workbooks.Open (MyFile)
MyFileName = ActiveWorkbook.Name

For Each Ws In ActiveWorkbook.Sheets
Ws.Activate
For SheetIndex = 1 To ThisWorkbook.Sheets.Count
If ActiveSheet.Name = ThisWorkbook.Sheets(SheetIndex).Name Then
ActiveWorkbook.ActiveSheet.Cells.copy
ThisWorkbook.Sheets(SheetIndex).Range("A1").PasteSpecial
End If
Next SheetIndex
Next Ws

Workbooks(MyFileName).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Success Fully Updated Data From Respecitve Sheets", vbInformation, "Success !!!"

Exit Sub
TPR:
MsgBox "Macro Failed/File Selection Cancelled", vbOKCancel, "FailedCancelled !!!"
MsgBox Err.Description 
End Sub

Ecofriendly.,
        Tamatam
                   MBA[Finance]                        

Thursday, 17 January 2013

How to Create a Dialog Box To Select and Merge Multiple Workbooks into Main Workbook

Excel VBA Macro to Open Dialog Box To Select and Merge Multiple Workbooks into Target Workbook
'This is Very User Friendly Macro that allows you to Merge Multiple Workbooks Selected from a open Dialog Box Into Our Workbook'

Sub CombineWorkbooks()

    Dim FilesToOpen As Variant
    Dim X As Integer

    On Error GoTo ErrHandler

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    FilesToOpen = Application.GetOpenFilename
 (FileFilter:="Microsoft Excel Files (*.xls*), *.xls*",MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then

        MsgBox "No Files Were Selected"
        GoTo ExitHandler
    End If

   X = 1

    While X <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        + 1
    Wend
    
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:

    MsgBox Err.Description, vbCritical, "Error"
    Resume ExitHandler
End Sub

Thanks,
Tamatam
  

Wednesday, 16 January 2013

Excel VBA Macro To Open a Dialog Box to Select a File and Copy All Sheets Into Main WorkBook

Excel VBA Macro To Open a File Dialog Box to Select a File and Copy All Sheets Into Target WorkBook
'Macro To Open a Dialog Box to Select a File and Dump All Sheets Into Our Work Book.
'All The Sheets are dumped in to our work book with respective sheet names and data.
'This is a very user friendly and powerful macro.
Option Explicit

Sub OpenDialogCopyFile()

Dim MyFile As Variant
Dim MyFileName As String
Dim Ws As Worksheet
Dim SheetIndex As Integer

Application.DisplayAlerts = False

Application.ScreenUpdating = False

On Error GoTo TPR:

SheetIndex = 1
MyFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")

'If MyFile = False Then Exit Sub


Workbooks.Open (MyFile)

MyFileName = ActiveWorkbook.Name

For Each Ws In ActiveWorkbook.Sheets

Ws.Activate
ActiveSheet.Copy After:=ThisWorkbook.Sheets(SheetIndex)
'Add Each sheet of selected file after first sheet of our file
SheetIndex = SheetIndex + 1
Next Ws

Workbooks(MyFileName).Activate

' Selected File Saving and Closing after Copied
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Success Fully Copied Selected Workbook", vbInformation, "Success !!!"
Exit Sub
TPR:
'If you cancel file selection / macro fails to run...then kick you this msgbox
MsgBox "Macro Failed/File Selection Cancelled", vbOKCancel, "Failed/Cancelled !!!"
End Sub

Thanks,

TAMATAM

Sunday, 13 January 2013

Excel GETPIVOTDATA Function Syntax and Example

Excel GETPIVOTDATA Function
If you want to use values from the pivot table elsewhere in the workbook, you can enter the appropriate cell references directly into the formulas. However, as the pivot table changes, these references might not refer to the correct values you want to use in the formula.

To solve this problem, Excel has a function called GETPIVOTDATA, which references values in the pivot table by their logical positions, rather than actual cell addresses. Even when the table is pivoted, the function still returns the correct value. 

However, if the referenced value is removed or hidden (such as by filtering or by hiding details), the function returns a #REF error.

When you are creating a formula and you click on a cell in a pivot table, Excel automatically inserts the appropriate GETPIVOTDATA function into the formula to refer to the value you selected.

Syntax:
GETPIVOTDATA(data_field,pivot_table,field1,item1,field2,item2,...)

Data_field is the name of the field in the data area from which we want to retrieve a value.
Pivot_table is any cell in the pivot table, usually the upper-left corner.
Fieldn/Itemn list the name of the column/row field and the specific item value of that field for the table value we want to return. This combination of field/item is repeated for all the fields that are required to identify the specific value in the pivot table.

Example:

Sample Pivot Table


Get Pivot Function Usage
Please refer and analyze the formula using the following example for better understating.

Sum of Sales
Sales_Period




Prod_ID
Q1-2014
Q2-2014
Q3-2014
Q4-2014
Grand Total
ABC_1234
157872
223764
163852
315189
860677
BCD_2345
207254
215188
225615
281984
930041
CDE_3456
222382
140506
156293
239015
758196
DEF_4567
224419
254021
295131
292883
1066454
EFG_5678
315015
222710
310269
272110
1120104
FGH_6789
207663
200940
193089
311924
913616
GHI_7890
221794
161097
185287
233228
801406
Grand Total
1556399
1418226
1529536
1946333
6450494


Get Pivot Function
 =GETPIVOTDATA("Sales",$B$3,"Prod_Id","DEF_4567",
"Sales_Period","Q3-2014")
Result
295131

Here in the above example shot , In the Getpivot Function , we use a cell reference '$B$3' which is refer to a Pivot_table is any cell in the pivot table, usually the upper-left corner . 

Note:
For better understanding of Getpivot Function ,  Do Practice in Real Time with Sample Data.

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts