Free Microsoft Excel 2013 Quick Reference

Pivot table raw data Results

I have a spreadsheet with raw data organised the way excel likes it (one row for headings and all the others for data). I have 40 columns or so. This data is a database for evaluating employees, so we have Name, Date, Evaluator, Marks for different qualities,..., SUM of different groups of qualities, overall mark, and a written summary. Every evaluation has a row of its own. So the names repeat themselves, marks repeat themselves,...

I want to do quite a number of things with this data. But have no idea how to eaven start. For example. I would like to have all individual employees that have been evaluated in one list with their "average" grade. Or I would like to be able to select an individual employee that has been evaluated and see his "average" grade, "average" sums of different groups of abbilities, the last written summary and so on and on and on (simmilar summaries for diffrent evaluators, for group leaders, graphs would be nice,...the list is practicaly endless ). Average is in quotes because it wouldn't really be average but 40% of the last evaluation, 40% of the two before that and 20% out of the rest).

As I said I have no idea where to eaven start with this so I would be eternaly grateful to any pointer in the right direction or an answer if this is eaven possible.

Hi,

I have the following raw data which is the results from a survey. I want to make a table which will look like the Thisis whatIwant worksheet. Pivot tables wont work, unless I make one for each individual category. I will be adding a lot more to the raw data table, so need something automatic. I realise I may need to change the way I am recording the data. Any idea?

Hi,

I've got a macro to put two data fields into each of several pivot tables. Several people on here helped me to make it and it's finally working

...But it runs super slow. I tried to read up on optimizing the macro and the only thing I found was that maybe I should explicitly declare "count" as an integer. Are there other things I can do to make this thing run faster?

And also, I have to be there to click on a whole bunch of popups; is there a way to automatically say "no" when the pop-ups ask if I want to overwrite the existing cells?

Below is my code. Thanks for any advice
Tai


	VB:
	
 PivotInitializer() 
     
    Application.ScreenUpdating = False 
    Dim PT As PivotTable 
    Dim PF As PivotField 
    Dim PF2 As PivotField 
    Dim F As String 
    Dim F2 As String 
     
     'refresh master cache
    Sheets("chart feeder").Activate 
    ActiveSheet.PivotTables("Master_1").PivotCache.Refresh 
    For Count = 1 To 10 
         
        F = Sheets("raw data").Cells(1 + Count, 2).Value 
        F2 = Sheets("raw data").Cells(1 + Count, 3).Value 
         
        If F  "" And F2  "" Then 
            Set PT = ActiveSheet.PivotTables("Master_" & Count) 
            Set PF = PT.PivotFields(F) 
            Set PF2 = PT.PivotFields(F2) 
            With PT.PivotFields(F) 
                .Orientation = xlDataField 
                .Position = 1 
                .Function = xlSum 
            End With 
            With PT.PivotFields(F2) 
                .Orientation = xlDataField 
                .Position = 2 
                .Function = xlSum 
            End With 
            Set PT = ActiveSheet.PivotTables("Selector_" & Count) 
            PT.PivotCache.Refresh 
            Set PF = PT.PivotFields(F) 
            Set PF2 = PT.PivotFields(F2) 
            With PT.PivotFields(F) 
                .Orientation = xlDataField 
                .Position = 1 
                .Function = xlSum 
            End With 
            With PT.PivotFields(F2) 
                .Orientation = xlDataField 
                .Position = 2 
                .Function = xlSum 
            End With 
        End If 
         
    Next 
    Application.ScreenUpdating = True 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi,

We are using several seperate raw data csv .txt files as source for multiple pivot tables with information on for example customer backorder, stock levels, sales QTY, forecast.

Is there a possibility to combine the .txt files into one range and use as a source for a pivot table that can give overview of all the above data?

all suggestions are welcome

Hi all,

I have chunks of raw data held in my spreadsheet and i am using pivot table to give me the final results based in the criteria selected, I now need to add another column to my pivot table to give me a percentage value from 2 values within the table- is this possible ?
(is there a way of adding a column into the table and insert a function to carry out the calculation?)
- I am looking to do it this way so that instant charts/reports can be easily made......

any suggestions?

thanks for looking

I operate a small music management company and I run my accounts using relatively complex Excel Workbooks with different sheets for purchase and sales ledgers, cash in and cash out etc etc. Each financial year has its own workbook. My problem is creating financial reports. For example, if I need to create a report for outgoings and incomings relating to a particular project (a concert tour for example), and if that project was split over several financial years, I find myself spending hours creating pivot tables, and then pivot tables based on other pivot tables etc etc, to just get a clean report on that particular project. What I would love to have is a single report generating system, where I can just enter the name of the project, and get a financial report at the click of a button, based on all the raw data I have painstakingly entered in the individual workbooks and sheets. I reckon I'm too busy to sit down and tackle VBA programming myself, so I wondered if anyone knew of any third party software that might help me realise my dream simply and easily. Someone has already mentioned Crystal Reports, but I don't know whether this will be overkill.

Thanks very much in advance for your help.

I have a macro that pulls in data from an external source and then creates a pivot table from the raw data set. The pivot table contains main headings of "Machine" and sub-headings for "Downtime Reasons" with a sum of the downtime minutes.

I am trying to automatically create graphs for each "Machine" and I am not sure how to code a loop function that would dynamically find the number of entries for the first machine, run the code to graph that, and then step to the next "Machine", run the graph code until it reached the "Grand Total" heading and would end the sub.

I think that I may be able to use some loop that would count the blank rows in column "A" until it reaches a text string for "*Total", go to the next heading, and continue until it reached the text string for "Grand Total". The number of headings and sub headings will constantly change.

I hope this isn't too confusing, but any help is appreciated.

thanks,

wfinn

Hi All,

Have succeeded in converting 40,000 lines of raw, useless data into a very tidy Pivot Table, but I have one more requirement!!!

Does anyone know a way I can set the account number (on the left) to be on its own line where I can use a V lookup to also add the account name.

At the moment I have what is in the pdf attached "Screenshot.pdf"

I would like to get to what is shown in "Book2.pdf"

Can I tell the pivot to place the heading at the top or will I have to record a macro to grab the data and manipulate it accordingly??

I am not so much interested in getting the account names right, I am just keen to be able to get excel to format the pivot table automatically without any need for a macro.,

Ideas anyone?

Thanks

Mark

Is there a way to create a chart based on data in a pivot table but have it place the data in different series?

I have a pivot table calculating the sum of total data for a "Rule", and the sum of data for the number of times the "Rule" was rejected.

If I have 2 rule, the chart currently comes out as 2 lines (In a line chart). I need 4 lines:
1 Line for rule1 rejected
1 Line for Rule1 total
1 Line for Rule2 rejected
1 line for Rule2 total.

I have attached a sample workbook. It has raw data and a pivot table (grouped on dat by 7 day period). It has the chart generated when using the chart wizzard. And then a "Desired Chart"

I have a pivot table I am building to show sales and margin for each of our dealers. Since the raw data our backend generates only has the value and cost fields, I use a calculated field to show our margin. However, where there were no sales to a dealer this quarter, the calculated field ("VALUE-COST") returns a zero, but I want zeros to be blank.

Here's what I tried in the calculated field:

	VB:
	
0,VALUE-COST,"") 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
This works when there is a nonzero margin, but when the margin is 0, I get an error #VALUE!.

I wound up working around this using a custom format, but is there any way to do this directly? Or can calculated fields only return numeric values?

Hi,

I have a dataset which i am analysing using a pivot table report (see attachment). It is the price and amount of two goods sold at different dates. In the pivot chart i am using dates to filter. However rather than getting data for a specific date (as in the file attached), I would like the report to return the most recent data available for each product. So rather than getting values for 'bread' for 30/06/10 and blank fields for 'Milk' (as there is no data), i would like 'Milk' to return the most recent values available in the raw data for 30/06/10, which would be for 30/03/10 (and clearly the 'bread' values for 30/06/10).

Please let me know if this is possible or the easiest way to achieve it.

Thanks

I work at a trading firm and use pivot tables to report on the success of traders on a daily basis. I add daily trading data to a raw data table that powers a set of reports. In one report I want to view MTD stats for a filtered group of 10 traders. The issue is that if I add a set of daily data that includes a new trader name, it will automatically be pre-checked and added to this report (and this happens daily). The only solution I came up with is to add another column in the raw data table that would allow me to group these traders and then use a page filter to include only them. This will work but I'd rather avoid adding columns to an already unruly data table (and would like flexibility to periodically define and track an arbitrary set of traders). Any thoughts?

Hi all,

I am new to pivot tables and have not found what i am looking for in the forums. Would be happy for any advice.

I have table listing the raw test data from a 'batch' of 'items'.
Each 'item' has 5 'sites' of measurements.
There are up to 50 tests that can be done for each site, item and batch, but i've only included up to 5 for the example file. Each test has its own set of spec limits. If the measurement is out of the spec limits, it will fail.

What i would like to do by pivot tables is to check each site data. The example final output is listed in the 'coversheet' ply in the attachment.

There are 5 possible outcomes for each site:
1: Less than lower spec limit (L)
2: Higher than upper spec limit (H)
3: Cell is blank, and this is taken to be a test failure (F)
4: Data passes

So for Test1, Item 2, a cell entry on the coversheet of '2F1L' means that out of 5 sites, 2 sites gave test fails, 1 site is low. If the cell entry on the coversheet is blank, means all 5 sites passed the spec limits.

The reason i would like to try using pivot tables is because i read it counts and tallies efficiently. I already have a spreadsheet to do all this but it runs too slowly because there are so many sumproducts and macros.

Thanks in advance,

Rivercup

I have a courier company (fictitious) that delivers packages among several buildings. As they travel, they get an ID code scanned to track delivery. I then get the data in a raw format I wish to re-sort in a manner similar to a pivot table.

There are three possible scans: Induction (when we receive the pkg), In Transit (as it travels) and Delivered. The issue is that it's possible to have more than one In Transit scan, so using a Pivot table doesn't give me desired results. What I really want to see is the Accepted date/time and the very first In Transit scan in order to see that the accepting office is moving it out of the building in a timely manner (e.g. same date or within xx hours).

Since there is more than one In Transit scan for each package ID, a pivot table won't work, because it gives counts rather than the date/time info I want. Please see the attached example. Is there a macro or code I can use to maipulate the data into a more manageable database as in my example? By the way, my "desired result" only shows the first and last In Transit scan, but having all of them (each in its own column, i.e. 1st in Transit, 2nd In Transit, etc) would be just fine.

Thanks for any help!
Rick

I've recorded a macro that clears a worksheet, fetches data from an Access Table and then creates a new pivot table. The Pivot Table Fields are summarized by "sum" and this worked the first few cycles for the macro. Now it is returning the Pivot Table Fields summarized by "count".

Can an option be inserted into the existing code to specify "sum"? Appreciate any feedback - Here is the code:

	VB:
	
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ 
"'raw data'!R1C1:R205C12").CreatePivotTable TableDestination:="", TableName _ 
:="PivotTable14" 
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) 
ActiveSheet.Cells(3, 1).Select 
ActiveSheet.PivotTables("PivotTable14").SmallGrid = False 
ActiveSheet.PivotTables("PivotTable14").AddFields RowFields:=Array("Name", _ 
"FIELD_ASM_USER_NAME", "Data") 
With ActiveSheet.PivotTables("PivotTable14").PivotFields( _ 
    "SumOfSumOfSumOfCYYTD_SHARE_QTY") 
    .Orientation = xlDataField 
    .Position = 1 
End With 
With ActiveSheet.PivotTables("PivotTable14").PivotFields( _ 
    "SumOfSumOfSumOfLYYTD_SHARE_QTY") 
    .Orientation = xlDataField 
    .Position = 2 
End With 
With ActiveSheet.PivotTables("PivotTable14").PivotFields( _ 
    "SumOfSumOfSumOfCYYTD_PRODUCT_GSB") 
    .Orientation = xlDataField 
    .Position = 3 
End With 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


I am having some trouble updating my pivot tables. There is one field that contains old values from previous data, it also has the new values. i have refreshed the pivot table many times, removed fields and saved, and refreshed, and completely removed every item from the PT and reinserted it. The values for a particular field are still not accurate. I looked at the raw data from which i construct the pivot table from and there are is no old data. i did an auto filter on the top and it only contains values i wanted. I have run into problems like this before and usually removing the field from the pivot table, refreshing and re-adding it works, but not this time. any advice would be greatly appreciated.

Drew

Hi All,

There are a huge amount data in my "raw data" spreadsheet, and it included five columns:
No. Day end bal (Jan) Day end bal (Feb) Day end bal (Mar) Customers Status
1 12131215 13454678 46548797779 Valued cust
2 456487977 4464867879 54684678979 Not Valued cust
3 32156446 46548797 3123147979 Valued cust
.
.
.
till 1800

Then, I consolidated two privot tables, one is for "valued cust another" is for "Not valued cust".

Like: (For Valued cust)
No.of cust in Jan xxx
Day end bal in Jan xxx
Day end bal in Feb xxx
Day end bal in Mar xxx

After that, I want to divide "the day end bal" in six groups, and sum up the valued, so can privot table do this?

500k -

Problem:
Run time error 2147417848 (80010108)
“Current page method of pivot field failed”

My macro ran once perfectly, but each subsequent time Excel freezes up and I have to shut Excel down.

Operating System: Windows 2000 Pro, Excel 2003

Experience: I don’t have much Excel VBA experience – no formal education.

Background:
I designed a pivot table based on a dynamic range (size is usually 5000 rows by 70 columns). My macro creates report sheets based on this pivot table by automatically switching the “page” field, and then copying and pasting the relevant data into new worksheets that are created when the macro is run.

The worksheets are named the same as the page field of the pivot table. Just as an example (not the same fields as my P.T), if page fields are large American cities, and the user wants reports for “Houston” and “Jacksonville”, they select these names from a validated list in the pivot table worksheet (this list is not a part of the pivot table), then start the macro. The macro automatically creates new worksheets that are named “Houston” and “Jacksonville” which contain the report for the city.

Steps Taken:

1) I’ve read the full version of Mike’s xtremeVB thread on “Automating Excel from VB 6.0” which includes MSKB 178510 & MSKB 319832 aritcles. (http://www.xtremevbtalk.com/archive/index.php/t-135815)

2) I’ve followed all the steps outlined in the article, including defining an object for the current instance of Excel, preceeding every function with this object, while using the “Automation Prophylactics” to compile all of my code to ensure there are no calls to a Global Object.

3) Closed this object at the end of my code.

Where I am Now: Excel still freezes everytime I run my code. I cannot select any cells or do anything else.

Thank you very much to anyone who can help me. If this post is in any way improper or in the wrong forum, please feel free to correct me.

Code:


	VB:
	
 
 
Public IntStartDay As Integer 
Public IntEndDay As Integer 
Public IntStartMonth As Integer 
Public IntEndMonth As Integer 
Public StrStartMonth As String 
Public StrEndMonth As String 
Public CurrentYear As Integer 
Public Historical As String 
Public oExcel As Excel.Application 
Public oWB As Excel.Workbook 
Public oWS As Excel.Worksheet 
Public oWSLoop As Excel.Worksheet 
 
Public Sub GradeSheets() 
     
     'Dim oExcel As Excel.Application
     'Dim oWB As Excel.Workbook
     'Dim oWS As Excel.Worksheet
     'Dim oWSLoop As Excel.Worksheet
     
    On Error Resume Next 
    Set oExcel = GetObject(, "Excel.Application") 
    Set oWB = oExcel.Workbooks("PM#4 - Grades - TPD") 
    Set oWS = oWB.Worksheets("Grade Sheet Calculator") 
     
    oExcel.ScreenUpdating = False 
    oExcel.Calculation = xlCalculationManual 
     
     '**************************************************
     ' "GradeSheets" Macro - PM#4
     '
     ' This macro extracts data from the
     ' "Grade Sheet Calculator" worksheet and uses it
     ' to create grade sheets for sorted by tonnes per day.
     '
     ' Richard Stock
     ' June 30, 2005
     '**************************************************
     
    oWB.Colors(48) = RGB(202, 6, 6) 
    oWS.Rows("2:1000").Select 
    oExcel.Selection.EntireRow.Hidden = False 
     
     '**************  Declare Variables  **********************
    Dim NumColumns As Integer 
    Dim StartDate 
    Dim EndDate 
    Dim StDate As String 
    Dim EndDte As String 
    Dim ActStDate 
    Dim ActEndDate 
    Dim x, y As Integer 
    Dim GradeSheet As String 
     
     '*************** Initialize Variables *****************
     
    NumColumns = 2 
    IntStartDay = Day(oWS.Cells(1, 7).Value) 
    IntEndDay = Day(oWS.Cells(2, 7).Value) 
    IntStartMonth = Month(oWS.Cells(1, 7).Value) 
    IntEndMonth = Month(oWS.Cells(2, 7).Value) 
    CurrentYear = Year(oWS.Cells(1, 7).Value) 
    If CurrentYear < 2003 Then 
        IntStartMonth = Month(oWB.Sheets("Raw Data").Cells(2, 3).Value) 
        IntEndMonth = Month(oWB.Sheets("Raw Data").Cells(3, 3).Value) 
        CurrentYear = Year(Now) 
    End If 
     
    If IntStartMonth = 1 Then StrStartMonth = "Jan" 
    If IntStartMonth = 2 Then StrStartMonth = "Feb" 
    If IntStartMonth = 3 Then StrStartMonth = "March" 
    If IntStartMonth = 4 Then StrStartMonth = "April" 
    If IntStartMonth = 5 Then StrStartMonth = "May" 
    If IntStartMonth = 6 Then StrStartMonth = "June" 
    If IntStartMonth = 7 Then StrStartMonth = "July" 
    If IntStartMonth = 8 Then StrStartMonth = "August" 
    If IntStartMonth = 9 Then StrStartMonth = "Sept" 
    If IntStartMonth = 10 Then StrStartMonth = "October" 
    If IntStartMonth = 11 Then StrStartMonth = "Nov" 
    If IntStartMonth = 12 Then StrStartMonth = "Dec" 
     
    If IntEndMonth = 1 Then StrEndMonth = "Jan" 
    If IntEndMonth = 2 Then StrEndMonth = "Feb" 
    If IntEndMonth = 3 Then StrEndMonth = "March" 
    If IntEndMonth = 4 Then StrEndMonth = "April" 
    If IntEndMonth = 5 Then StrEndMonth = "May" 
    If IntEndMonth = 6 Then StrEndMonth = "June" 
    If IntEndMonth = 7 Then StrEndMonth = "July" 
    If IntEndMonth = 8 Then StrEndMonth = "August" 
    If IntEndMonth = 9 Then StrEndMonth = "Sept" 
    If IntEndMonth = 10 Then StrEndMonth = "October" 
    If IntEndMonth = 11 Then StrEndMonth = "Nov" 
    If IntEndMonth = 12 Then StrEndMonth = "Dec" 
     
    If StrStartMonth = StrEndMonth Then 
        If IntEndDay - IntStartDay > 25 Then 
            Historical = "Historical Averages for " & StrStartMonth & " " & CurrentYear 
        ElseIf IntEndDay - IntStartDay = 7 Then 
            Historical = "Historical Averages for Week of " & StrStartMonth & " " & IntStartDay & " - " & StrEndMonth & " " &
IntEndDay & ", " & CurrentYear 
        Else 
            Historical = "Historical Averages for " & StrStartMonth & " " & IntStartDay & " - " & StrEndMonth & " " &
IntEndDay & ", " & CurrentYear 
        End If 
    ElseIf IntStartMonth < IntEndMonth Then 
        Historical = "Historical Averages for " & StrStartMonth & " - " & StrEndMonth & " " & CurrentYear 
    Else 
        Historical = "Historical Averages for " & StrStartMonth & " - " & StrEndMonth & " " & CurrentYear 
    End If 
     
    StartDate = oWS.Cells(1, 7).Value 
    EndDate = oWS.Cells(2, 7).Value 
    ActStDate = oWS.Cells(1, 4).Value 
    ActEndDate = oWS.Cells(2, 4).Value 
     
    StDate = "" & ActEndDate 
     
     '***** Hide Dates That are Outside Of User Selected Date Range ********
    oWS.Range("B3").Select 
    If oWS.Cells(2, 4).Value = "" Then 
        oExcel.Selection.Group Start:=True, End:=True, By:=1, Periods:=Array(False, _ 
        False, False, True, False, False, False) 
    Else 
        oExcel.Selection.Group Start:=StartDate, End:=EndDate, By:=1, Periods:=Array(False, _ 
        False, False, True, False, False, False) 
        With oWS.PivotTables("Summary").PivotFields("TIMESTAMP") 
            .PivotItems(StDate).Visible = False 
            .PivotItems(EndDte).Visible = False 
        End With 
    End If 
     
     'Application.Run "'PM#4 - Grades - TPD.xls'!CreateSheets"
     '
     'End Sub
     '
     'Public Sub CreateSheets()
     
     
     
     '*********   DELETE OLD GRADESHEETS  **********************
    If oWS.Cells(1014, 1).Value = "Yes" Then 
        y = oWB.Sheets.Count 
        oExcel.DisplayAlerts = False 
        For x = 4 To y 
            oWB.Worksheets(4).Delete 
        Next x 
        oExcel.DisplayAlerts = True 
    End If 
     
     '**********  DECLARE VARIABLES    **************************
    Static a, b, c, aLoop As Integer 
    Dim TopDataCellRow, LeftmostDataCellCol, NumberofDataColumns As Integer 
    Dim PM4FirstTagRow, PM4TagColumn, NumberofWorksheets As Integer 
    Dim UnitsPath As String 
    Dim Grade As String 
    Dim GradeNumber As Variant 
    Dim TopLeftDataCell As String 
    Dim Average As Range 
    Dim ExitLoop As Boolean 
    Dim strAverageAddress As String 
    Dim intAverageAddress As Integer 
    Dim KeepGoin As Boolean 
    Dim LoopCounter As Integer 
    Dim NumberofMissingColumns As Integer 
     
     '************* Create Grade Sheets ***************
     
    LoopCounter = 1002 
    KeepGoin = False 
     
    Do 
         
        If oWS.Cells(LoopCounter, 1) = "" Then 
            Exit Do 
        Else 
            KeepGoin = True 
        End If 
         
        oExcel.ScreenUpdating = False ' Disables screen changes
         
         '**********  INITIALIZE VARIABLES  ************************
        If oWS.Cells(LoopCounter, 1) = "All" Then 
            Grade = "(All)" 
        Else 
            Grade = Trim(Str(oWS.Cells(LoopCounter, 1))) ' Grade of paper
        End If 
         
        TopDataCellRow = 6 ' Row of data immediately after headings
        LeftmostDataCellCol = 3 ' Column of data immediately after units column (A=1,B=2,C=3,etc)
        NumberofDataColumns = 7 ' # of Data Columns Not Including "Avg." column
        PM4FirstTagRow = 9 ' Row number of first tag in "Tags" worksheet (PM # 4)
        PM4TagColumn = 2 ' Column number of first tag in "Tags" worksheet (PM # 4) - (A=1,B=2,C=3,etc)
        UnitsPath = "='[Data Extractor.xls]Tags'!R" ' Excel link to "Tags" worksheet
         
         '***********   CREATE GRADESHEET  ***************************
        If StrStartMonth = StrEndMonth Then 
            If IntEndDay - IntStartDay > 25 Then 
                GradeSheet = Grade & " (" & StrStartMonth & ", " & CurrentYear & ")" 
            ElseIf IntEndDay - IntStartDay = 7 Then 
                GradeSheet = Grade & " (" & StrStartMonth & " " & IntStartDay & " - " & StrEndMonth & " " & IntEndDay & ", "
& CurrentYear & ")" 
            Else 
            End If 
        ElseIf IntStartMonth < IntEndMonth Then 
            GradeSheet = Grade & " (" & StrStartMonth & " - " & StrEndMonth & ", " & CurrentYear & ")" 
        Else 
             
        End If 
         
        NumberofWorksheets = oWB.Worksheets.Count 
        oWB.Worksheets.Add After:=oWB.Worksheets(NumberofWorksheets) 
        oWB.ActiveSheet.Name = GradeSheet 
        Set oWSLoop = oWB.Worksheets(GradeSheet) 
         
         '***********   LINK DESCRIPTIONS   **************************
        GetData oExcel.ThisWorkbook.Path & "Data Extractor.xls", "Tags", "A8:A150", oWSLoop.Range("A6"), True 
         
         
         
         '    Windows("Data Extractor.xls").Activate
         '    oExcel.Run "'Data Extractor.xls'!WBActivateHandler"
         '    Sheets("Tags").Select
         '    Range("A8:A150").Select
         '    Selection.Copy
         '    Windows("PM#4 - Grades - TPD.xls").Activate
         '    oWSLoop.Range("A6").Select
         '    oWSLoop.Paste Link:=True
         
        oWB.ActiveSheet.Range("A4").FormulaR1C1 = "Production at Reel (tonnes/day)" 
        oWSLoop.Range("A4").Select 
        oExcel.Selection.Font.Bold = True 
        oExcel.Selection.Font.Italic = True 
         
        oWSLoop.Columns("A:A").ColumnWidth = 33.78 
        oWSLoop.Range("A6").Select 
        oExcel.Selection.FormatConditions.Delete 
        oExcel.Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _ 
        Formula1:="0" 
        oExcel.Selection.FormatConditions(1).Font.ColorIndex = 2 
         
        oExcel.Selection.Copy 
        oWSLoop.Range("A7:B150").Select 
        oExcel.Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
        SkipBlanks:=False, Transpose:=False 
         
        oWSLoop.Range("A6").Select 
        oExcel.Selection.Font.Bold = True 
        oExcel.Selection.Font.Underline = xlUnderlineStyleSingle 
         
        oWSLoop.Columns("B:B").Select 
        With oExcel.Selection.Font 
            .Name = "Arial" 
            .Size = 8 
            .Strikethrough = False 
            .Superscript = False 
            .Subscript = False 
            .OutlineFont = False 
            .Shadow = False 
            .Underline = xlUnderlineStyleNone 
            .ColorIndex = xlAutomatic 
        End With 
         
         '***********    COPY AND PASTE DATA INTO GRADESHEETS ********
        oWS.Select 
         ' To avoid run-time errors set the following property to True.
         'ActiveSheet.PivotTables("Summary").CubeFields("GRADE").EnableMultiplePageItems = True
        oWB.ActiveSheet.PivotTables("Summary").PivotFields("GRADE").CurrentPage = Grade 
         
        aLoop = oExcel.WorksheetFunction.CountIf(oWS.Columns(1), "Average") 
         
        If aLoop = 0 Then 
            oExcel.DisplayAlerts = False 
            oWB.Worksheets(NumberofWorksheets + 1).Delete 
            oExcel.DisplayAlerts = True 
            Goto LastLine 
        End If 
         
        b = LeftmostDataCellCol 
        Set Average = oWS.Range("A4") 
         
        For a = 1 To aLoop 
            oWS.Select 
             
             ' Find "Average" in Column "A"
            Set Average = oWS.Columns(1).Find(What:="Average", After:=Average, LookIn:=xlValues, Lookat:=xlWhole,
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) 
             
             ' Copy heading
            Average.Activate 
            strAverageAddress = Mid(oExcel.ActiveCell.Address, 4) 
            intAverageAddress = Val(strAverageAddress) + 1 
            oWS.Range(oExcel.Selection, oExcel.Selection.End(xlUp)).Select 
            intAverageAddress = intAverageAddress - oExcel.Selection.Rows.Count 
            oWS.Cells(intAverageAddress, 1).Select 
            oExcel.Selection.Copy 
            oWSLoop.Select 
            oWSLoop.Cells(4, b).Select 
            oExcel.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
            :=False, Transpose:=False 
             
             ' Copy data
            oWS.Select 
            Average.Activate 
            oExcel.ActiveCell.Offset(0, 2).Select 
            oWS.Range(oExcel.ActiveCell, oExcel.ActiveCell.End(xlToRight)).Select 
            oExcel.Selection.Copy 
             
            oWSLoop.Select 
            oWSLoop.Cells(TopDataCellRow, b).Select 
            oExcel.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
            :=False, Transpose:=True 
            oExcel.CutCopyMode = False 
             
            b = b + 1 
        Next a 
         
        oWS.Select 
        Set Average = oWS.Range("A4") 
        Set Average = oWS.Columns(1).Find(What:="Grand Average", After:=Average, LookIn:=xlValues, Lookat:=xlWhole,
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) 
        Average.Activate 
        oExcel.ActiveCell.Offset(0, 2).Select 
        oWS.Range(oExcel.ActiveCell, oExcel.ActiveCell.End(xlToRight)).Select 
        oExcel.Selection.Copy 
         
        oWSLoop.Select 
        oWSLoop.Cells(TopDataCellRow, b).Select 
        oExcel.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
        :=False, Transpose:=True 
        oExcel.CutCopyMode = False 
         
        oWSLoop.Cells(4, b).FormulaR1C1 = "Avg." 
        oWSLoop.Range(oWSLoop.Cells(4, LeftmostDataCellCol), oWSLoop.Cells(4, b)).Select 
        oExcel.Selection.Font.Bold = True 
        With oExcel.Selection 
            .HorizontalAlignment = xlRight 
            .VerticalAlignment = xlBottom 
            .WrapText = False 
            .Orientation = 0 
            .AddIndent = False 
            .IndentLevel = 0 
            .ShrinkToFit = False 
            .ReadingOrder = xlContext 
            .MergeCells = False 
        End With 
         
         ' Format White Background for top 2 rows
        oWSLoop.Range(oWSLoop.Cells(1, 1), oWSLoop.Cells(2, b)).Select 
        With oExcel.Selection.Interior 
            .ColorIndex = 2 
            .Pattern = xlSolid 
        End With 
        oExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
        oExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
        oExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone 
        oExcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone 
        With oExcel.Selection.Borders(xlEdgeBottom) 
            .LineStyle = xlContinuous 
            .Weight = xlMedium 
            .ColorIndex = xlAutomatic 
        End With 
        oExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone 
        oExcel.Selection.Borders(xlInsideVertical).LineStyle = xlNone 
        oExcel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
         
         ' Copy "Hercules" logo over to gradesheet (TOP LEFT)
        oWS.Select 
        oWB.ActiveSheet.Shapes("Group 46").Select 
        oExcel.Selection.Copy 
        oWSLoop.Select 
        oWSLoop.Range("A1").Select 
        oWB.ActiveSheet.Paste 
        oExcel.Selection.ShapeRange.LockAspectRatio = msoTrue 
        oExcel.Selection.ShapeRange.Height = 16.8 
        oExcel.Selection.ShapeRange.Width = 174.6 
        oExcel.Selection.ShapeRange.Rotation = 0# 
         
         ' Insert PM # 4 Heading (TOP RIGHT)
        oWSLoop.Cells(2, b).FormulaR1C1 = "PM # 4" 
        oWSLoop.Cells(2, b).Select 
        oExcel.Selection.Font.Bold = True 
        oExcel.Selection.Font.Italic = True 
        With oExcel.Selection.Font 
            .Name = "Arial" 
            .Size = 12 
            .Strikethrough = False 
            .Superscript = False 
            .Subscript = False 
            .OutlineFont = False 
            .Shadow = False 
            .Underline = xlUnderlineStyleNone 
            .ColorIndex = xlAutomatic 
        End With 
        oExcel.Selection.Font.ColorIndex = 48 
         
         ' Insert "Historical Averages For" Statement (TOP RIGHT)
        oWSLoop.Range(oWSLoop.Cells(1, 2), oWSLoop.Cells(1, b)).Select 
        oExcel.Selection.ClearContents 
        oWSLoop.Cells(1, b - 2).Value = Historical 
        oWSLoop.Cells(1, b - 2).Select 
        With oExcel.Selection.Font 
            .Name = "Arial" 
            .Size = 9 
            .Strikethrough = False 
            .Superscript = False 
            .Subscript = False 
            .OutlineFont = False 
            .Shadow = False 
            .Underline = xlUnderlineStyleNone 
            .ColorIndex = xlAutomatic 
        End With 
        oExcel.Selection.Font.Italic = True 
         
         
         '************* SHIFT DATA ******************************
         
        b = LeftmostDataCellCol 
        NumberofMissingColumns = 0 
        Do 
            If IsEmpty(oWSLoop.Cells(TopDataCellRow, b).Value) = True Then 
                NumberofMissingColumns = NumberofMissingColumns + 1 
            End If 
            b = b + 1 
        Loop While b < NumberofDataColumns + LeftmostDataCellCol 
        oWSLoop.Cells(TopDataCellRow, LeftmostDataCellCol).Select 
        oExcel.ActiveCell.CurrentRegion.Select 
        oExcel.Selection.Cut Destination:=oExcel.ActiveCell.Offset(0, NumberofMissingColumns) 
         
         '****** ALIGN DATA WITH HEADINGS (INSERT 2 ROWS BETWEEN SECTIONS) ******
        b = TopDataCellRow 
        ExitLoop = False 
        Do 
            If oWSLoop.Cells(b, 1).Value = "0" Then 
                oWSLoop.Cells(b, LeftmostDataCellCol).Select 
                oWSLoop.Range(oExcel.ActiveCell, oExcel.ActiveCell.End(xlToRight)).Select 
                oExcel.Selection.Insert Shift:=xlDown 
                oExcel.Selection.Insert Shift:=xlDown 
                b = b + 1 
                If oWSLoop.Cells(b, 1).Value = "0" Then 
                    ExitLoop = True 
                Else 
                    oWSLoop.Cells(b, 1).Select 
                    oExcel.Selection.Font.Bold = True 
                    oExcel.Selection.Font.Underline = xlUnderlineStyleSingle 
                    b = b - 1 
                End If 
            End If 
            b = b + 1 
        Loop While ExitLoop = False 
         
         '**** RENEW LINKS TO UNITS ("TAGS" WORKSHEET IN "DATA EXTRACTOR" WORKBOOK) **
        ExitLoop = False 
        b = TopDataCellRow + 1 
        c = PM4FirstTagRow 
        Do 
            If oWSLoop.Cells(b, 1).Value = "0" Then 
                b = b + 1 
                If oWSLoop.Cells(b, 1).Value = "0" Then 
                    ExitLoop = True 
                Else 
                    b = b - 1 
                End If 
            End If 
            oWSLoop.Cells(b, 2).FormulaR1C1 = UnitsPath & c & "C" & PM4TagColumn 
            b = b + 1 
            c = c + 1 
        Loop While ExitLoop = False 
         
         '************ FORMAT DATA CELLS (NO BOLD, ALIGN LEFT) *****************
        oWSLoop.Range(oWSLoop.Cells(TopDataCellRow, LeftmostDataCellCol), oWSLoop.Cells(300, 20)).Select 
        oExcel.Selection.Font.Bold = False 
        With oExcel.Selection 
            .HorizontalAlignment = xlRight 
            .VerticalAlignment = xlBottom 
            .WrapText = False 
            .Orientation = 0 
            .AddIndent = False 
            .IndentLevel = 0 
            .ShrinkToFit = False 
            .ReadingOrder = xlContext 
            .MergeCells = False 
        End With 
        With oExcel.Selection.Font 
            .Name = "Arial" 
            .Strikethrough = False 
            .Superscript = False 
            .Subscript = False 
            .OutlineFont = False 
            .Shadow = False 
            .Underline = xlUnderlineStyleNone 
            .ColorIndex = xlAutomatic 
        End With 
        With oExcel.Selection.Font 
            .Name = "Arial" 
            .Size = 10 
            .Strikethrough = False 
            .Superscript = False 
            .Subscript = False 
            .OutlineFont = False 
            .Shadow = False 
            .Underline = xlUnderlineStyleNone 
            .ColorIndex = xlAutomatic 
        End With 
        oExcel.Selection.NumberFormat = "0.000" 
        oWSLoop.Columns("E:E").ColumnWidth = 9.22 
         
         '********* FORMAT COUNTS OF DATA (RED FONT, ITALICS) ********************
        oWSLoop.Range(oWSLoop.Cells(TopDataCellRow, LeftmostDataCellCol), oWSLoop.Cells(TopDataCellRow, 20)).Select 
        oExcel.Selection.Font.Italic = True 
        oExcel.Selection.NumberFormat = "0" 
        oExcel.Selection.Font.ColorIndex = 48 
        oWSLoop.Cells(TopDataCellRow, 2).FormulaR1C1 = "COUNT" 
        oWSLoop.Cells(TopDataCellRow, 2).Select 
        oExcel.Selection.Font.ColorIndex = 48 
         
         ' Insert Grade Heading
        oWSLoop.Cells(2, 4).FormulaR1C1 = "Grade" 
        oWSLoop.Cells(2, 5).FormulaR1C1 = Grade 
        oWSLoop.Range(oWSLoop.Cells(2, 4), oWSLoop.Cells(2, 5)).Select 
        oExcel.Selection.Font.Bold = True 
        With oExcel.Selection.Font 
            .Name = "Arial" 
            .Size = 16 
            .Strikethrough = False 
            .Superscript = False 
            .Subscript = False 
            .OutlineFont = False 
            .Shadow = False 
            .Underline = xlUnderlineStyleNone 
            .ColorIndex = xlAutomatic 
        End With 
         
         
        oExcel.ActiveWindow.Zoom = 85 
         
        oWS.Select 
        oExcel.ScreenUpdating = True 
         
LastLine: 
        LoopCounter = LoopCounter + 1 
         '
    Loop While KeepGoin = True 
     
    oExcel.Calculation = xlCalculationAutomatic 
    oExcel.ScreenUpdating = True 
     
     'Clean up
    Set oWS = Nothing 
    Set oWSLoop = Nothing 
     'If Not oWB Is Nothing Then oWB.Close
    Set oWB = Nothing 
     'oExcel.Quit
    Set oExcel = Nothing 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hello:

I would like your help with a macro.

I put together the following macro:

	VB:
	
Sheets("Raw Data").Select 
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ 
"'Raw Data'!R4C1:R343C17").CreatePivotTable TableDestination:="", TableName _ 
:="PivotTable1", DefaultVersion:=xlPivotTableVersion10 
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
How do I ensure that even if I have more than 343 rows, that the macro will capture all the row in my raw data table.

I am trying to provide a table showing chargeable time by staff member. The raw data is as shown in the attached spreadsheet. There are three staff members, the client code #NonC means non-chargeable time and alongside the data is the table I wish to see. Essentially I would like one column which is the Total column minus the #NonC column. A pivot table is also included. Part of the problem of manipulating this table is that in real life there are more than 256 unique client codes, thereby exhausting the number of columns in Excel. The data is output from another system and the user this is intended for will not want to add extra columns to the data or play around with the pivot table.

Thanks
regh


No luck finding an answer? You could always try Google.