Results 1 to 3 of 3

Thread: Pivot Table Help

  1. #1

    Pivot Table Help



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Using the following code to create a pivot table across multiple worksheets.


    Code:
    Option Explicit
    Const PIVOTNAME = "TestPivot"
    Dim strFileExt As String
    Dim lngFileFormat As Long




    '
    Sub CreateConnection()
    Dim PT As PivotTable
    Dim PC As PivotCache
    Dim strFile As String
    Dim strFileTemp As String
    Dim strPath As String
    Dim arrSheets As Variant
    Dim strSQL As String
    Dim strCon As String
    Dim i As Long


    ' Sheets to consolidate
    '*****************************************************************************
    arrSheets = Array("System 1", "System 2", "System 3", "System 4")
    '*****************************************************************************


    If Val(Application.Version) > 11 Then
    DeleteConnections_12
    CheckFileFormat_12
    Else
    strFileExt = ".xls"
    lngFileFormat = xlNormal
    End If


    Application.ScreenUpdating = False
    With ThisWorkbook
    strPath = .Path
    strFile = .FullName
    strFileTemp = strPath & "\DBtemp" & Format(Now, "yyyymmddhhmmss") & strFileExt
    ActiveSheet.Cells.Clear
    .Worksheets(arrSheets).Copy
    End With


    With ActiveWorkbook
    .SaveAs strFileTemp, lngFileFormat
    .Close
    End With


    For i = LBound(arrSheets) To UBound(arrSheets)
    If arrSheets(i) <> ActiveSheet.Name Then
    If strSQL = "" Then
    strSQL = "SELECT * FROM [" & arrSheets(i) & "$]"
    Else
    strSQL = strSQL & " UNION ALL SELECT * FROM [" & arrSheets(i) & "$]"
    End If
    End If
    Next i


    strCon = _
    "ODBC;" & _
    "DSN=Excel Files;" & _
    "DBQ=" & strFileTemp & ";" & _
    "DefaultDir=" & strPath & ";" & _
    "DriverId=790;" & _
    "MaxBufferSize=2048;" & _
    "PageTimeout=5"


    Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)


    With PC
    .Connection = strCon
    .CommandType = xlCmdSql
    .CommandText = strSQL
    Set PT = .CreatePivotTable(TableDestination:=ActiveSheet.Range("A1"))
    PT.Name = "TestPivot"
    End With


    With PT.PivotCache
    .Connection = Replace(strCon, strFileTemp, strFile)
    End With


    'Clean up
    Kill strFileTemp
    Set PT = Nothing
    Set PC = Nothing


    End Sub




    Sub ReestablishConnection()
    Dim strFile As String
    Dim strPath As String
    Dim strCon As String


    With ThisWorkbook
    strPath = .Path
    strFile = .FullName


    strCon = _
    "ODBC;" & _
    "DSN=Excel Files;" & _
    "DBQ=" & strFile & ";" & _
    "DefaultDir=" & strPath & ";" & _
    "DriverId=790;" & _
    "MaxBufferSize=2048;" & _
    "PageTimeout=5"


    With .Worksheets("Sheet1")
    If .PivotTables.Count > 0 Then .PivotTables(PIVOTNAME).PivotCache.Connection = strCon
    End With
    End With
    End Sub




    Private Sub DeleteConnections_12()
    Dim con
    Dim PT As PivotTable
    ' This line won't work and wouldn't be necessary
    ' in the versions older than 2007
    '*****************************************************************************
    On Error Resume Next
    With ThisWorkbook
    Set PT = .Worksheets("Pivot").PivotTables(PIVOTNAME)
    For Each con In .Connections
    If con.ODBCConnection.Connection = PT.PivotCache.Connection _
    And con.ODBCConnection.CommandText = PT.PivotCache.CommandText Then
    con.Delete
    End If
    Next con
    End With
    On Error GoTo 0
    '*****************************************************************************
    End Sub




    Sub CheckFileFormat_12()
    With ThisWorkbook
    Select Case .FileFormat
    Case 51: strFileExt = ".xlsx": lngFileFormat = 51
    Case 52:
    If .HasVBProject Then
    strFileExt = ".xlsm": lngFileFormat = 52
    Else
    strFileExt = ".xlsx": lngFileFormat = 51
    End If
    Case 56: strFileExt = ".xls": lngFileFormat = 56
    Case Else: strFileExt = ".xlsb": lngFileFormat = 50
    End Select
    End With
    End Sub




    Sub SamplePivot()
    Dim PT As PivotTable


    CreateConnection
    Set PT = ThisWorkbook.Worksheets("Sheet1").PivotTables(PIVOTNAME)


    With PT


    With .PivotFields(11) 'Material or Spec
    .Orientation = xlRowField
    .Position = 1
    End With


    With .PivotFields(10) 'Description
    .Orientation = xlRowField
    .Position = 2
    End With


    With .PivotFields(8) 'Size 1
    .Orientation = xlRowField
    .Position = 3
    End With


    With .PivotFields(9) 'Size 2
    .Orientation = xlRowField
    .Position = 4
    End With


    With .PivotFields(5) 'System
    .Orientation = xlPageField
    .Position = 1
    End With
    With .PivotFields(26) 'Total Qty's
    .Orientation = xlColumnField
    .Position = 1
    End With
    End With


    'Clean up
    Set PT = Nothing
    Application.ScreenUpdating = True
    End Sub


    looks like this code is combining the 4 different worksheets using the entire worksheet. My data starts in cell "A8" and goes thru column "Y". The number of rows will vary. What do i need to change in code to have it begin in the correct location and not do the entire sheet? Or is there a better way to do this. I was originally using the data connection from MS Query to do this and defined the ranges using the name function. This method is path and filename specific so as other users would copy the template files and rename it in another location the pivot table wouldn't work any longer.


    attached is my excel file for additional information.

    2014 Mechanical Bid Form.xlsm

  2. #2
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    I seem to recall that if you are using ODBC on an excel sheet it treats the whole sheet as a database table. Thus you do not have the option to select a range.
    A quick and dirty fix could be to create a new sheet and link new!A1 = old!A8 etc.

  3. #3
    if that's the case, why when i use the get external data from Microsoft Query and use ranges defined with code in the second screen shot it let's me define something other than the entire sheet? There is another Select * from system4 command not shown in the screen shot

    Click image for larger version. 

Name:	Capture2.PNG 
Views:	3 
Size:	26.9 KB 
ID:	2821 Click image for larger version. 

Name:	Capture.PNG 
Views:	5 
Size:	56.1 KB 
ID:	2822

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •