macro and pivottable

Q

qwertyjjj

Registered User.
Local time
Today, 14:45
Joined
Aug 8, 2006
Messages
262
This code seems to work but it seems to put in the data incorrectly when the number of worksheets differs.
It retrieves data from a database and runs the pivottable wizard, which puts all data for the codes ZCCA etc. into a different worksheet.
Problem is that when it's now run, there are some blanks appearing in the pivot table, i.e. the work (blank).

Any ideas on how to solve this? Example Data.xls attached.

Code: 
Sub MakePivotTable()

' PivotTable

    Cells.Select
    Selection.Delete Shift:=xlUp

    With ActiveSheet.QueryTables.Add(Connection:= _
        "ODBC;DRIVER=SQL Server;SERVER=10.4.1.47;APP=Microsoft Office 2003;DATABASE=CCApp;Trusted_Connection=Yes" _
        , Destination:=Range("A1"))
        .CommandText = Array("exec ledgerreport 'joe bloggs'")
        .Name = "Query from 10.4"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    
    '---------------------------------------------------------
    'find out number of rows
    '---------------------------------------------------------
    'Get the total number of rows in the spreadsheet so we know where to copy the formula to.
    Dim intLastRow As Integer
    intLastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    'MsgBox "Last row is " & intLastRow
    
    '---------------------------------------------------------
    'John's macro
    '---------------------------------------------------------
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Outstanding Amount"
    With ActiveCell.Characters(Start:=1, Length:=18).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-13]=R[1]C[-13],"""",RC[-1])"
    Range("P2").Select
    Selection.AutoFill Destination:=Range("P2", "P" & intLastRow)
    Range("P2", "P" & intLastRow).Select
    Range("L12").Select
    Application.CommandBars("PivotTable").Visible = True
    
    'ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    '    "Sheet1!R1C1:R518C16").CreatePivotTable TableDestination:="", TableName:= _
    '    "PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R[" & intLastRow & "]C16").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10
        
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:=Array( _
        "accountcode", "cust_name", "invoice_no", "inv_date", "project_no", _
        "projdesc", "projman", "notedate", "Note"), PageFields:="costcent"
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Outstanding Amount")
        .Orientation = xlDataField
        .Caption = "Sum of Outstanding Amount"
        .Function = xlSum
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("cust_name").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Range("C4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("invoice_no").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Range("D4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("inv_date").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Range("F4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("project_no").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Range("G4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("projdesc").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Range("H4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("projman").Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    Range("I4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("notedate").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("B8").Select
    ActiveSheet.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel, True
    ActiveSheet.PivotTables("PivotTable1").Format xlTable7
    ActiveWindow.SmallScroll ToRight:=9
    Range("J3").Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("accountcode")
        .Orientation = xlRowField
        .Position = 1
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("B:B").Select
    Columns("K:K").Select
    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
    Range("K8").Select
    ActiveWindow.DisplayZeros = False
    Sheets("Sheet3").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Sheet2").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Data"
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Whole Ledger"
    Range("C22").Select
    ActiveSheet.PivotTables("PivotTable1").ShowPages PageField:="costcent"
    Sheets("Whole Ledger").Select
    ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:=Array( _
        "accountcode", "cust_name", "costcent", "invoice_no", "inv_date", "Status", _
        "project_no", "projdesc", "projman", "notedate", "Note")
    ActiveWorkbook.ShowPivotTableFieldList = True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("C3").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("costcent").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    'Sheets(Array("ZBBC", "ZBFP", "ZBSY", "ZDDA", "ZGLC", "ZGLP", "ZHSY", "ZTLY", _
    '    "Whole Ledger")).Select
    Sheets.Select
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    ActiveWindow.LargeScroll ToRight:=1
    Columns("K:K").Select
    Selection.ColumnWidth = 50
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveWindow.LargeScroll ToRight:=1
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Sheets("Whole Ledger").Select
    Columns("J:J").ColumnWidth = 20
    Columns("K:K").ColumnWidth = 50
    Range("A1").Select
End Sub
 

Attachments

Last edited:
You must log in or register to reply here.

Similar threads

L
Retrieve excel from access (vol 4) , extended format , alternative color
Replies
7
Views
1,480
arnelgp
arnelgp
B
Solved VBA code which exports data from Access to Excel and then loops through the Excel file
Replies
0
Views
1,095
BlueFllame
B
J
Solved Create Excel Pivot Table From Access VBA
2
Replies
25
Views
4,600
jo15765
J
Sam Summers
Inserting subform/Table data into specific fields in Excel
2
Replies
22
Views
3,445
Gasman
Gasman
J
Solved Convert An Excel Macro To Run In Access VBA
Replies
12
Views
2,361
jo15765
J

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom