Solved

VBA Code to Dump Data using a MS Access Query into an Excel Template and Then Run Excel Macro

Posted on 2013-07-01
6
644 Views
Last Modified: 2014-02-18
I have a Form that takes the choices that the user selects from drop-downs, and enters this information into a query's criteria that is the record source for a button on this Form. I also have an Excel Template that contains a Macro that creates 5 sheets that are Pivot Tables and/or Pivot Charts.

For the button on the Form, I need to know how to create VBA code that will dump the data from the Query mentioned above, into the Excel Template into a Sheet named "Detail".  Then once the data is populated in the "Detail" sheet, I need the Excel Macro that I created to run and create the other 5 sheets (Pivot Tables/Charts).

If I manually dump the data into the Excel Template's Detail tab, and manually run the Excel Macro for this Template, it works fine.  

The problem that I am having is getting the data from the query dumped into the Excel Template via VBA Code, and then have it run the Excel Macro to create the 5 sheets.  The Macro is also set up so it forces the user to do a File SaveAs and save the spreadsheet once all the sheets have been created, to a new name, so that the original Excel Template is never overwritten.  It brings up a dialog box with a specific path, and then prompts the user to give it a new name, and then it closes the Excel Template without saving any changes, thus keeping the Excel Template in its original state.

What VBA Code could I use to open the Excel Template, dump the data from the query into a tab named "Detail", and then run the Excel Macro to create the 5 sheets (Pivot Tables/Charts)?

Below I have included the SQL View for the MS Access Query I'm using for the datasource (Detail) tab in the Excel Template, all the code for the Excel Macro/Module1, and the Code for the WorkBook.

Query SQL View:
SELECT DISTINCT tblEmployee_Audits.InquiryNum, tblEmployee_Audits.Manager_Name, tblEmployee_Audits.Department AS [Assoc Ops Area], tblEmployee_Quality_Review_Info.Assoc, tblEmployee_Audits.Employee, tblEmployee_Quality_Review_Info.Quality_Review_Criteria, tblEmployee_Audits.Quality_Review_Date, Format([Quality_Review_Date],"mmmm") AS [Month]

FROM tblEmployee_Audits LEFT JOIN tblEmployee_Quality_Review_Info ON tblEmployee_Audits.InquiryNum = tblEmployee_Quality_Review_Info.InquiryID

GROUP BY tblEmployee_Audits.InquiryNum, tblEmployee_Audits.Manager_Name, tblEmployee_Audits.Department, tblEmployee_Quality_Review_Info.Assoc, tblEmployee_Audits.Employee, tblEmployee_Quality_Review_Info.Quality_Review_Criteria, tblEmployee_Audits.Quality_Review_Date, Format([Quality_Review_Date],"mmmm")

HAVING (((tblEmployee_Quality_Review_Info.Assoc)="Y") AND ((tblEmployee_Audits.Employee)=[Forms]![frmReports]![cboCategSelect] Or (tblEmployee_Audits.Employee)=[Forms]![frmReports]![cboCategSelect]) AND ((tblEmployee_Audits.Quality_Review_Date) Between [Forms]![frmReports]![txtBeginDT] And [Forms]![frmReports]![txtEndDT]))
OR ((([Forms]![frmReports]![txtBeginDT]) Is Null) AND (([Forms]![frmReports]![txtEndDT]) Is Null))

ORDER BY tblEmployee_Audits.Manager_Name, tblEmployee_Audits.Employee, tblEmployee_Audits.Quality_Review_Date;

Open in new window


Excel Template's Macro:
Sub macQtrlyAssocReport(Optional Str As String = "")
Dim ws As Worksheet
Dim i As Long
Dim cel As Range, rg As Range
Application.ScreenUpdating = False
Application.EnableEvents = False

' turn off compatibility checker
ActiveWorkbook.CheckCompatibility = False

On Error Resume Next
    Set ws = Worksheets("Q1 Audit Criteria_Graph")
    On Error GoTo 0
    If Not ws Is Nothing Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    End If

' Create Monthly Summary
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R35C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Summary", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveSheet.Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("Summary")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc Ops Area")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
        .Name = "Assoc Error"
    End With
'    Range("H2").Select
    With ActiveSheet.PivotTables("Summary").PivotFields("Month")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
        .Name = "Audit Criteria Associate"
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Audit Criteria Associate")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Summary").PivotFields("Employee").Orientation = _
        xlHidden
    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Summary").AddDataField ActiveSheet.PivotTables( _
        "Summary").PivotFields("InquiryNum"), "", xlCount

    ActiveWorkbook.ShowPivotTableFieldList = False
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error"). _
    EnableMultiplePageItems = True
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error").CurrentPage = _
        "Y"
    ActiveSheet.PivotTables("Summary").PivotFields("Month").CurrentPage = _
        "(All)"
    ActiveSheet.PivotTables("Summary").PivotFields("Month"). _
        EnableMultiplePageItems = True

    ActiveSheet.PivotTables("Summary").ShowDrillIndicators = False

    Range("A7").Select
    Selection.Value = "Audit Criteria Associate"

    Range("A1:A4").Select
    Selection.Font.Bold = True

    Range("B1:B4").Select
    Selection.Font.Italic = True
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Summary"

' Create Quarterly Summary By Associate
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Assoc", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Assoc")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Assoc").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Assoc").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
'    Dim ws As Worksheet
'    Dim cel As Range, rg As Range
'    Dim i As Long
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data

' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
' Format certain Columns
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("A1:A2").Select
    Selection.Font.Bold = True

    Range("B1:B2").Select
    Selection.Font.Italic = True

' Move the Sheet to put in a particular order
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)

' Wrap Text in Column A
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select

' Rename the Active Sheet
    ActiveSheet.Name = "Q1 Summary by Associate"


' Create Quarterly Summary By Audit Criteria
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Audit Criteria", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    Range("A6").Select
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Criteria")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Audit Criteria").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A2").Select
    Columns("A:A").ColumnWidth = 52.14
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data


' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("B1:B2").Select
    Selection.Font.Italic = True
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select
    ActiveSheet.Name = "Q1 Summary By Audit Criteria"

    
' Create Audit Criteria Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Audit Criteria_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
   With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    Dim cht As Chart
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlBarStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Audit Criteria_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
'    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 6)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 600
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Audit Criteria_Graph"
    
    
' Create Associate Error Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Associate Error_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlColumnStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartArea.Interior.ColorIndex = 48
        .PlotArea.Interior.ColorIndex = 15
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Associate Error_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    ActiveChart.ChartTitle.Text = "Audit Criteria Errors"
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 8)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 270
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Associate Error_Graph"


' remove any sheets that are not named and are blank
Application.DisplayAlerts = False

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Delete
        End If
    Next ws

Application.DisplayAlerts = True


' Move focus back to Summary Sheet
Sheets("Summary").Select
Range("A8").Select

Application.EnableEvents = True

End Sub

Open in new window


Workbook_Open Event: (Which I've commented out the line that automatically runs the macro when the Excel Template opens).
Private Sub Workbook_Open()
If Me.FileFormat = 52 Then      '.xlsm file format
'    macQtrlyAssocReport
    Application.ScreenUpdating = True
    Saver
End If
End Sub

Open in new window


Workbook_SheetChange Event:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rg As Range
Dim obj As Object
If (Sh.PivotTables.Count = 1) And (Sh.ChartObjects.Count = 1) Then
    Set rg = Sh.PivotTables(1).TableRange2
    If Not Intersect(rg, Target) Is Nothing Then
        Application.EnableEvents = False
        Sh.ChartObjects(1).Left = rg.Cells(5, rg.Columns.Count + 2).Left
        Set obj = Selection
        Sh.Cells(1, 1).Select
        With Sh.Cells.Borders
            .LineStyle = xlNone
        End With
        Cells.Borders.LineStyle = xlLineStyleNone
        With rg.Borders
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        obj.Select
        Application.EnableEvents = True
    End If
End If
End Sub

Open in new window


Saver Code
Sub Saver(Optional Str As String = "")
' Save Workbook
Dim f As String, flPath As String, flName As String, i As Variant
flPath = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Reports\Operational_Reports\"   'Path
f = Application.GetSaveAsFilename(flPath & "*.xls", FileFilter:="Excel files (*.xls),*.xls", _
    Title:="Choose the desired *.xls file name and location, then click 'Save'")
If f <> "False" Then
    i = InStrRev(f, Application.PathSeparator)
    flName = Mid(f, i + 1)
    If (LCase(Right(flName, 4)) = ".xls") And (flName <> ActiveWorkbook.Name) Then
'        iMod.Remove VBComponent:=iMod.Item("Module1")
        ActiveWorkbook.SaveAs flPath & flName, FileFormat:=xlExcel12  'Save as .xls file
    Else
        MsgBox "File not saved. You must pick a different name and must use .xls file extension."
    End If
End If
End Sub

Open in new window


Thanks,
gdunn59
0
Comment
Question by:gdunn59
  • 3
6 Comments
 

Author Comment

by:gdunn59
ID: 39307438
It's been 5 days since the last posting, still waiting for assistance.

Thanks,
gdunn59
0
 
LVL 57
ID: 39310340
Since it appears your not a beginner to VBA coding, I'll just get you going in the right direction.

There are two methods to get data into Excel from Access:

1. DoCmd.TransferSpreadsheet

2. OLE Automation

  With the first, it's the simplest, but also gives you the least amount of control.  The syntax is:

DoCmd.TransferSpreadsheet [transfertype][, spreadsheettype], tablename, filename,[ hasfieldnames][, range]

  So the best you can do is export to a named range.

 The second gives you complete control; it's like you opening up an instance of Excel and carrying out actions, but your doing it under program control.

  Since you'll need to use this to run the excel code anyway, this is the approach I would use.   Using this, you can push data into individual cells, named ranges, etc.   Anything you can do in Excel in VBA, you can do once you have an Excel object.

 The following MSKB article:

ACC97: How to Run Macros in Other Office Programs
http://support.microsoft.com/kb/177760

 in the second example shows you how to create an Excel instance, then run an Excel macro.

 Let me know if that's enough to get you started or if you need more.

Jim.
0
 
LVL 57
ID: 39310346
BTW, the following is a great example of how to start your procedure in Access for controlling Excel.

Jim.

Sub OLEAutomationLateBinding()
' replace xxx with one of the following:
' Access, Excel, Outlook, PowerPoint or Word

Dim oApp As Object ' late binding
Dim oDoc As Object ' late binding
    On Error Resume Next ' ignore errors
    Set oApp = GetObject(, "xxx.Application")
    ' reference an existing application instance
    If oApp Is Nothing Then ' no existing application is running
        Set oApp = CreateObject("xxx.Application")
        ' create a new application instance
    End If
    On Error GoTo 0 ' resume normal error handling
    If oApp Is Nothing Then ' not able to create the application
        MsgBox "The application is not available!", vbExclamation
    End If
    With oApp
        .Visible = True ' make the application object visible
        ' at this point the application is visible
        ' do something depending on the application...
        Set oDoc = .Documents.Open("c:\foldername\filename.doc")
        ' open a document
'        ...
        oDoc.Close True ' close and save the document
        .Quit ' close the application
    End With
    Set oDoc = Nothing ' free memory
    Set oApp = Nothing ' free memory
End Sub
0
 
LVL 57

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 500 total points
ID: 39310361
BTW, there is one other thing you should be aware of:  Early binding vs late.

With early binding, you need to set a reference to the object lib (in the VBA editor, it's tools/references).  When you do that, your tied to a specific version.  *but* you gain intellisense when your coding and it's faster then late.

With late binding, you create an object generically, so you don't get intellisense when coding and it's slower at runtime.

Some developers will develop using early binding, and then switch to late binding for production (so they don't have to worry about what Excel version is installed on a machine).

 Again, he's a MSKB article with the details and shows you how you would do each in VBA:

Using early binding and late binding in Automation
http://support.microsoft.com/kb/245115

The example in the last comment was late binding.

Jim.
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now