1
votes

I am trying to set up a Macro in excel which will select a range for a pivot table. The only thing is that the range is never the same. It all depends on how many checks have been written. The way I would like for it to work is do CTRL down arrow then back up twice to start the selection. Then from there shift to column f then Control Up to select range. Here is a screen shot of the data I want in a pivot table. The code for the macro is below the data.

Bank Account                    
Checks   Check Number     Date      Amount   Reterence     Reconciled?
            2002        6/3/2016    -20.00     Fred             C
            2003        6/3/2016    -30.00     George           N
            2004        6/3/2016    -40.00     Sue              N
            2005        6/3/2016    -50.00     Greg             C
            2006        6/3/2016    -10.00     McDonalds        C
            2007        6/3/2016    -20.00     Wendys           N
            2008        6/3/2016    -30.00     KFC              C
            2009        6/3/2016    -40.00     WalMart          C
            2006        6/3/2016    -50.00     Kmart            C
            2007        6/3/2016    -60.00     Kroger           N
            2008        6/3/2016    -70.00     Dollar General   N
            2009        6/3/2016    -80.00     Sears            C
Check Total                       -$500.00          

Deposits                    
                       11/3/2014     50.00     Deposit          Y
                       11/3/2014     60.00     Deposit          Y
                       11/3/2014     70.00     Deposit          Y
                       11/3/2014     80.00     Deposit          Y
                       11/3/2014     10.00     Deposit          Y
                       11/3/2014     20.00     Deposit          Y
                       11/3/2014     30.00     Deposit          Y

And the code:

Range("A4").Select
Selection.End(xlDown).Select
Range("A4").Select
Selection.End(xlDown).Select
Range("A15").Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Sheet1!R3C1:R15C6", Version:=xlPivotTableVersion10).CreatePivotTable _
    TableDestination:="Sheet2!R3C1", TableName:="PivotTable3", DefaultVersion _
    :=xlPivotTableVersion10
Sheets("Sheet2").Select
Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
    "PivotTable3").PivotFields("Amount"), "Sum of Amount", xlSum
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Reconciled?")
    .Orientation = xlRowField
    .Position = 1
End With
Range("D3").Select
1
can't you simply run a Evaluate("MATCH(MAX(B:B),B:B,0)") to get the row which is the last to use (assuming the bottom most value is the highest)?Dirk Reichel
Thank you, Dirk. I was trying to figure the editing out.D. Wilson
I am trying to do a pivot table on all checks but the Number of checks is never the same.D. Wilson
I assumed that the checks are in column B. Then it looks for the highest value in there (MAX) and returns its row number (MATCH)... also Application.Match(99999,Range("B:B")) can return the last row with a check-number if numbers are following after the last check... isn't that all you want to know?Dirk Reichel
where would I put the Evaluate("MATCH(MAX(B:B),B:B,0)") in my codeD. Wilson

1 Answers

0
votes

Wilson,

I trust this will answer your question. I had a similar problem a while back and managed to implement a solution, of course you will need to adapt the code to your specific needs (or hire me).

It took me almost half a day to complete and document this example so, please, by all means, read the code comments carefully before asking.

Since you did not provide an Excel example I did my best to mimic the file you have and understand its purpose. There are several steps to accomplish what you want, perhaps the most crucial (and difficult to get - at first) is the dynamic range. Please read the code comments carefully and the source material if you have questions.

You will need to set a dynamic range and use that range as a reference to create the pivot table (easier said than done). Best of luck, do let me know if this helped you.

Working example can be downloaded form here: https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm

Here is the code created for this project:

Option Explicit

Public Sub DynamicRange()

    '---------------------------------------------------------------------------------------
    ' Method : DynamicRange
    ' Author : vicsar
    ' Date   : 6/15/2016
    ' Purpose: Shows how to specifiy a dynamic range for a pivot table in Excel and automate the pviot report creation
    ' Ref.: https://stackguides.com/questions/37817289/how-do-i-specifiy-a-dynamic-range-for-a-macro-in-excel
    ' Tested in Office 2013 (Problems with Pivot Tables might arise on diferent versions of Microsoft Office)
    ' See Create a Dynamic Named Range in Excel 2003 from http://www.contextures.com/xlNames01.html#videodynamic to understand
    ' how the dinamic range works
    ' Working example can be downloaded form here:
    ' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm
    '---------------------------------------------------------------------------------------

    On Error GoTo MistHandler

    ' Let's begin by handling posible human errors
    ' Check if the RawData sheet exists, if it doesn't then warn the user
    If WorksheetExists("RawData") = False Then
        MsgBox "The RawData worksheet has not been found. Please create it, the procedure (and the fate of humanity) depends on it." _
               & Chr$(13) _
               & Chr$(13) _
               & "If the worksheet exists then check the spelling, please name it properly before proceding.", vbCritical, "vicsar says"
        Exit Sub
    End If

    ' Check if the PivotReport sheet exists, if it does  then warn the user
    If WorksheetExists("PivotReport") = True Then
        MsgBox "A worksheet named PivotReport has been found. Please rename or delete it before proceding.", vbCritical, "vicsar says"
        Exit Sub
    End If

    ' Using this will make the procedure run faster. You won't be able to see what the macro is doing,
    ' but it will run faster, specially beneficial when you have thousands of rows.
    Application.ScreenUpdating = False

    ' Aesthetics
    Sheets("RawData").Select
    ActiveWindow.DisplayGridlines = False
    With ActiveWorkbook.Sheets("RawData").Tab
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0
    End With

    ' Let's begin by creatign a dynamic reference for the pivot report
    ' You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand.
    ' Note: Dynamic named ranges will not appear in the Name Box dropdown list. However, you can type the names in the Name Box,
    ' to select the range on the worksheet.
    ' If the Named Data Range exist it will be re-writen
    ' Formula for this specific project: =OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))
    ActiveWorkbook.Names.Add Name:="DynamicDataRange", RefersTo:= _
                             "=OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))"
    ActiveWorkbook.Names("DynamicDataRange").Comment = "You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand."


    ' Add destination sheet for the pivot table
    Worksheets.Add().Name = "PivotReport"
    Sheets("PivotReport").Select

    ' This example shows how to add a pivot table based on the dynamic range.
    ' You will have to manually arrange the PivotTable fields
    'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
     '        "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _
     '        TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _
     '        DefaultVersion:=xlPivotTableVersion15
    'Sheets("PivotReport").Select
    'Cells(1, 1).Select

    ' This example shows how to add a pivot table based on the dynamic range.
    ' The PivotTable fields are set for the user
    '
    ' Inserting the Pivot Table
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                                      "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _
                                      TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _
                                      DefaultVersion:=xlPivotTableVersion15
    Sheets("PivotReport").Select
    Cells(1, 1).Select

    ' Defining the PivotTable fields
    ' Adding fields to the ROWS area
    With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields( _
         "Reconciled?")
        .Orientation = xlRowField
        .Position = 1
    End With

    ' Adding fields to the VALUES area
    ActiveSheet.PivotTables("DynamicRangePivotTable").AddDataField ActiveSheet. _
                                                                   PivotTables("DynamicRangePivotTable").PivotFields("Amount"), "Sum of Amount", _
                                                                   xlSum
    ' Adding fields to the ROWS area, again... because reasons... it has to be done in this order if you use
    ' the same field on the ROWS and VALUES areas
    With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields("Amount")
        .Orientation = xlRowField
        .Position = 2
    End With

    ' Refreshing the Pivot Table cache
    ActiveSheet.PivotTables("DynamicRangePivotTable").PivotCache.Refresh

    ' Moar Aesthetics
    With ActiveWorkbook.Sheets("PivotReport").Tab
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
    End With
    ActiveWindow.DisplayGridlines = False

    ' Allowing screen updates again
    Application.ScreenUpdating = True

    MsgBox "The process completed succesfully. - And so the world saw the birth of a new era...", vbInformation, "vicsar says"


    On Error GoTo 0
    Exit Sub

MistHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DynamicRange of basMain", vbExclamation, "vicsar says"

End Sub

Public Function WorksheetExists(ByVal strWorksheetName As String) As Boolean
    '---------------------------------------------------------------------------------------
    ' Method : WorksheetExists
    ' Author : vicsar
    ' Date   : 6/16/2016
    ' Purpose: Boolean - Checks if a worksheet exists
    '---------------------------------------------------------------------------------------

    On Error GoTo MistHandler

    Dim objSheet As Worksheet

    For Each objSheet In ThisWorkbook.Worksheets
        If Application.Proper(objSheet.Name) = Application.Proper(strWorksheetName) Then
            WorksheetExists = True
            Exit Function
        End If
    Next objSheet

    WorksheetExists = False


    On Error GoTo 0
    Exit Function

MistHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WorksheetExists of basMain", vbExclamation, "vicsar says"

End Function