Solved

open a spreadsheet and do a pivot table macro

Posted on 2013-12-25
10
348 Views
Last Modified: 2014-01-08
Hi,
I want to open a spreadsheet and do a pivot table using a macro.

The spreadsheet will be on the desktop and will vary on the file name. therefore, I'd when the macro starts, i'd like to browse for the file, open, then perform the pivot table.

At the end i'd like to display a msgbox showing the date in A2, to confirm the correct report was run.

Exchange (Row Labels), Date (Column Labels), Quantity (Values) – SUM not count                                          
I'd like to copy all data from A5:B (last row with data), not including if A, has a value of (blank).

Sheet1 is the name of the filename (minus the file extension). I'd prefer not to specify, but if i have to, I need to make it this. I need to replace  "Dec2013" with whatever Sheet1 may be named (which would be the filename minus extension).

Ive given a go so far. I can get it working up to the point where it opens the file, just need assistance with the Sheet1 part mentioned. then need some help with the actual pivot, and the copy of the data mentioned above.

here is my code thus far:

Dim wsClient As Worksheet
Dim wkbClient As Workbook
Dim wkbThis As Workbook
Dim pivotdate As String

Sub PivotN()
'start code
 Set wkbThis = ThisWorkbook
  
  ' Open Client Workbook
  Set wkbClient = OpenWorkbook(True)
  ' Set wkbClient = OpenWorkbook1()
    LetsPivot ' calls pivot table sub
    pivotdate = wkbClient.Sheets("Dec2013").Range("A2").Value
    MsgBox ("Pivot Table Complete [" & pivotdate & "]. Data copied. Now paste.")
    
  If wkbClient Is Nothing Then
    MsgBox "No valid workbook has been provided, Exiting..."
    Exit Sub
  Else
    ' If we know the worksheet name
    ' clientWSName = "Foglio1"
    ' Find the client worksheet by name
    ' Set wsClient = wkbClient.Sheets(clientWSName)
    ' This assumes the client worksheet is the first
    If (wkbClient.Worksheets.Count > 0) Then
       Set wsClient = wkbClient.Worksheets(1)
    Else
       MsgBox "Unable to process - no worksheet available"
       Exit Sub
    End If
    
    If (wsClient Is Nothing) Then
      MsgBox "Null client worksheet..."
      Exit Sub
    Else
      ' MsgBox "Got a client worksheet: " & wsClient.UsedRange.Count
    End If
    
     End If
    
End Sub
' Function to open a workbook using the File Dialog
Public Function OpenWorkbook(mode As Boolean) As Excel.Workbook
Dim sFile As String
Dim ShortName As String
Dim autoSecurity As MsoAutomationSecurity
Set OpenWorkbook = Nothing
Dim wkb As Workbook

autoSecurity = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.csv"
    .FilterIndex = 1
    .Title = "Please Select File to open"
    If .Show = False Then Exit Function
    sFile = .SelectedItems(1)
    End With

ShortName = Right(sFile, Len(sFile) - InStrRev(sFile, "\"))

If CheckSourceAvailability(ShortName) Then
  Workbooks(ShortName).Close
End If

Application.EnableEvents = False
If (mode) Then
  Set wkb = Workbooks.Open(sFile, ReadOnly:=True, UpdateLinks:=0)
  On Error GoTo 0
Else
  Set wkb = Workbooks.Open(sFile)
End If
Application.EnableEvents = True

Set OpenWorkbook = wkb
Debug.Print OpenWorkbook.Name
clientFileName = sFile
Application.AutomationSecurity = autoSecurity

errOpen:
  If (Err.Number > 0) Then
    MsgBox "Error: " & Err.Description & "ErrNo: " & Err.Number
  End If

End Function
Public Function CheckSourceAvailability(sWorkBook As String) As Boolean
    Dim wb As Workbook, bResult As Boolean
    bResult = False
    For Each wb In Application.Workbooks
        If InStr(LCase(wb.Name), LCase(sWorkBook)) > 0 Then
            bResult = True
            Exit For
        End If
    Next wb
    CheckSourceAvailability = bResult
End Function

Sub LetsPivot()

    Const SourceSheet As String = ""
    Const PivotName As String = "PivotN"
    Const TargetCell As String = "A1"
    
    Const ColumnCaptions As String = "Date"
    
    ThisWorkbook.ShowPivotTableFieldList = False
End Sub

Open in new window

0
Comment
Question by:jfrank14
  • 5
  • 5
10 Comments
 
LVL 12

Expert Comment

by:Harry Lee
ID: 39754812
jfrank14,

I can get the VBA macro setup for you.

Can you please upload a sample file for me?
0
 

Author Comment

by:jfrank14
ID: 39754937
see attached:
sample-Dec2013.csv
0
 
LVL 12

Expert Comment

by:Harry Lee
ID: 39755028
jfrank14,

Please try the following code. This code is meant to be stored in the personal macro library instead of the working file.


Sub CreatePivotTable()

Dim NewFN As Workbook
Dim curWorkbook As Workbook
'
'-----------------------------------------------------------'
'   Request New Excel File
'
    NewFFN = Application.GetOpenFilename(Title:="PLEASE SELECT AN ACKLAND SMS REPORT FILE")
    If NewFFN = False Then
        MsgBox "Macro Terminated Due to No File Selected"
        Exit Sub
        Else
            Workbooks.Open Filename:=NewFFN
    End If
    Set NewFN = ActiveWorkbook
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Save File with Suffix "Pivot Table"

    OrgFName = ActiveWorkbook.Name
    OrgFFName = ActiveWorkbook.FullName
    Fnamelength = Len(OrgFName)
    OrgfPath = Left(OrgFFName, Len(OrgFFName) - Fnamelength)
    NewFName = Left(OrgFName, InStr(OrgFName, ".") - 1) & " Pivot Table"
    NewFFName = OrgfPath & NewFName

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs NewFFName, FileFormat:=50
    Application.DisplayAlerts = True
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Record Report Date
'
    Dim RptDate As String
    RptDate = ActiveSheet.Range("A2")
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Turn off screen update and calculation to speed up macro
'
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Duplicate sheet for backup
'
    ActiveSheet.Copy Before:=Sheets(1)
    Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Correct number stored as text
'
Dim I2 As Object
    For Each I2 In ActiveSheet.UsedRange
        I2 = I2.Value
    Next I2
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Delete unwanted rows (Column A is Blanks).
'
    With ActiveSheet
        .AutoFilterMode = False
        With Range("A1:A100000")
            .AutoFilter 1, "="
            On Error Resume Next
            Range("A2:A100000").SpecialCells(12).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Active Sheet Auto Fit
'
    ActiveSheet.Columns.AutoFit
    Set curWorkbook = ActiveWorkbook
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Page Setup to fit on 1 page wide
'
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
    End With
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Create Pivot Table to obtain summary
'
    ActiveSheet.UsedRange.Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Sheets(1).UsedRange).CreatePivotTable TableDestination:="", _
        TableName:="Pivot Summary", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("Pivot Summary").PivotFields("Exchange")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Pivot Summary").PivotFields("Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Pivot Summary").AddDataField ActiveSheet.PivotTables( _
        "Pivot Summary").PivotFields("Traded Quantity"), "Sum of Traded Quantity", _
        xlSum
    ActiveSheet.Columns.AutoFit
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Re-enable screen update and calculations
'
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Range("A1").Select
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Save Workbook
'
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Report Completion Notification
'
    MsgBox ("Pivot Summary For Report " & RptDate & " is Completed")

End Sub

Open in new window

0
 

Author Comment

by:jfrank14
ID: 39760122
perfect, thanks!

How can I add at the end to copy:
A5:B(last row). Not including the grant total line?

Then in the msgbox, i'll add:

MsgBox ("Pivot Summary For Report " & RptDate & " is Completed. Data copied to clipboard.")

Thanks!
0
 
LVL 12

Accepted Solution

by:
Harry Lee earned 500 total points
ID: 39760675
jFrank14,

I think this is what you need.

Sub CreatePivotTable()

Dim NewFN As Workbook
Dim curWorkbook As Workbook
'
'-----------------------------------------------------------'
'   Request New Excel File
'
    NewFFN = Application.GetOpenFilename(Title:="PLEASE SELECT AN ACKLAND SMS REPORT FILE")
    If NewFFN = False Then
        MsgBox "Macro Terminated Due to No File Selected"
        Exit Sub
        Else
            Workbooks.Open Filename:=NewFFN
    End If
    Set NewFN = ActiveWorkbook
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Save File with Suffix "Pivot Table"

    OrgFName = ActiveWorkbook.Name
    OrgFFName = ActiveWorkbook.FullName
    Fnamelength = Len(OrgFName)
    OrgfPath = Left(OrgFFName, Len(OrgFFName) - Fnamelength)
    NewFName = Left(OrgFName, InStr(OrgFName, ".") - 1) & " Pivot Table"
    NewFFName = OrgfPath & NewFName

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs NewFFName, FileFormat:=50
    Application.DisplayAlerts = True
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Record Report Date
'
    Dim RptDate As String
    RptDate = ActiveSheet.Range("A2")
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Turn off screen update and calculation to speed up macro
'
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Duplicate sheet for backup
'
    ActiveSheet.Copy Before:=Sheets(1)
    Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Correct number stored as text
'
Dim I2 As Object
    For Each I2 In ActiveSheet.UsedRange
        I2 = I2.Value
    Next I2
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Delete unwanted rows (Column A is Blanks).
'
    With ActiveSheet
        .AutoFilterMode = False
        With Range("A1:A100000")
            .AutoFilter 1, "="
            On Error Resume Next
            Range("A2:A100000").SpecialCells(12).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Active Sheet Auto Fit
'
    ActiveSheet.Columns.AutoFit
    Set curWorkbook = ActiveWorkbook
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Page Setup to fit on 1 page wide
'
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
    End With
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Create Pivot Table to obtain summary
'
    ActiveSheet.UsedRange.Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Sheets(1).UsedRange).CreatePivotTable TableDestination:="", _
        TableName:="Pivot Summary", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("Pivot Summary").PivotFields("Exchange")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Pivot Summary").PivotFields("Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Pivot Summary").AddDataField ActiveSheet.PivotTables( _
        "Pivot Summary").PivotFields("Traded Quantity"), "Sum of Traded Quantity", _
        xlSum
    ActiveSheet.Columns.AutoFit
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Re-enable screen update and calculations
'
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Range("A1").Select
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Save Workbook
'
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Copy Data Into Clipboard
'
    Dim CopyRng As Range, LastPivotRow As Long
    LastPivotRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
    Set CopyRng = Range(Cells(5, 1), Cells(LastPivotRow, 2))
    CopyRng.Value.Copy
'
'-----------------------------------------------------------
'-----------------------------------------------------------
'   Report Completion Notification
'
    MsgBox ("Pivot Summary For Report " & RptDate & " is Completed. Data is Copied to Clipboard.")

End Sub

Open in new window

0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 

Author Comment

by:jfrank14
ID: 39762161
thanks for the above. MSGbox looks good, no errors, however doesnt actually copy the data.

when I go to paste into another sheet just to test, its not in the clipboard.

Is it copying data from A5 to B (last row) ?
(not including Grand total Line) ?

not sure why its not pasting.

thanks.
0
 
LVL 12

Expert Comment

by:Harry Lee
ID: 39762985
jFrank14,

when you look into the code line 138 - 144, that's where the copy happens. You have to make sure you don't press ESC to cancel the copy.

I can program the VBA to put into into the clipboard, but it involve Enabling the Microsoft Forms 2.0 Run-Time library in order to do so, and it's not working very well.

What exactly do you want to achieve putting the pivot table data into the clipboard? Are you pasting it in another excel file, Email, or some other software such as text editor?
0
 

Author Comment

by:jfrank14
ID: 39763001
yea, want to paste (as values) into another file (in excel) which will be open in specific area.
0
 
LVL 12

Assisted Solution

by:Harry Lee
Harry Lee earned 500 total points
ID: 39763788
jFrank14,

Sorry for a minor error. Please modify line 143 from
CopyRng.Value.Copy
to
CopyRng.Copy

I have forgotten to remove the .Value from it.
0
 

Author Closing Comment

by:jfrank14
ID: 39765635
awesome! works like a charm. thanks again!
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

747 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

10 Experts available now in Live!

Get 1:1 Help Now