VBA code to stack data for pivot table

S

shawzito

New Member
Joined
Jun 2, 2011
Messages
9
Hi All -

I work in a group where I get a lot of different data dumps that I need to import into a pivot table and trend out (monthly financial statement information).

What i'll often get is monthly data in separate excel files, and I'll want to trend it out over months (for example, monthly trial balances). If i do this manually i'll have to stack each individual file into one file and then run a pivot. This takes a long time.

In addition, sometimes the individual excel files have 3 column (GL, Description, Amount), and sometimes they have 2 columns (GL, amount), or sometimes they have 4 columns, etc. It just depends.

I have a macro (attached) that takes the information in "Sheet1" which are my monthly trial balance and coverts it into pivot table "stacked" data in "Sheet2". You can see how it works by running "SetUpforPivot" in the macro.

This makes my life so much easier (i just copy and paste each trial balance into sheet1 and I'm done).

However, sometimes the individual excel files have 3 column (GL, Description, Amount), and sometimes they have 2 columns (GL, amount), or sometimes they have 4 columns, etc. It just depends. In order to correct this, I'll end up using concatenate to convert the data into two columns, bring it into the "stacked" pivot table, and then use text to column to split it back up into the original data format.

I wanted to know if there was a way to change the code, such that, when i first run the macro, it ask me how many columns my data is (each month), and then adjust the macro so that if it's 3 columns it stacks 3 columns of data, and if it's 4, it stacks 4 columns of data. That way I don't have to use the concatenate function and/or text to column function anymore.

My original excel file so you can see how the current macro works is below.

http://www.sendspace.com/file/3z6bnk


Thank you!
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Do the columns always have the same titles? And if there are 4 columns rather than 2, do you only need 2 of the four, or is the data you need just spread out more (between 4 columns rather than 2)? If the former is the case it's not so hard, but the latter could be a bit of a challenge.

If you can provide an example of multiple spreadsheets in the different formats you might encounter that would help. I see two in your example file...are there more?
 
Last edited:
Upvote 0
Blue_Elliott said:
Do the columns always have the same titles? And if there are 4 columns rather than 2, do you only need 2 of the four, or is the data you need just spread out more (between 4 columns rather than 2)? If the former is the case it's not so hard, but the latter could be a bit of a challenge.

If you can provide an example of multiple spreadsheets in the different formats you might encounter that would help. I see two in your example file...are there more?
Click to expand...

The columns do not have to have the same titles (they usually do though since it's monthly information and its consistent from month to month, if that makes sense), and if there are 4 columns, i need all 4 columns. I attached an example of how i get the data and then convert it to pivot table. This is an example of 3 columns that i would encounter. An example of 4 columns, would be maybe there is a location and i wanted to add that to each monthly trial balance. Right now i can only pivot 2 columns with my macro, but i'd like the functionality to be able to pivot any number of columns and remove having to go through the step of using concatenate get my data into a two column format.

http://www.sendspace.com/file/eev4ap
 
Last edited:
Upvote 0
So it's quite a lot of work, and unfortunately I don't have time to give you a thorough example (unfortunate because it's an interesting problem), but if you have some fluency with programming VBA here's how I would do it:

Step 1: you can either drop all the data into separate worksheets manually, or, depending upon how you get the flat files, write some code to call each workbook and automatically paste the data into a new sheet on your pivot table sheet.

Step 2: Make a pivot table sheet with the headings you want at the top

Step 3: using a series of loops and case statements, test the headings on each worksheet of data and if the headings match a heading on your pivot sheet, copy and paste the data to the end of your data on the pivot sheet. This will involve heavy use of offset, as well as dynamic range definition using the end.xl family of functions.

Step 4: Again using dynamic ranges, insert a pivot table based upon your pivot data.

This would probably take me about 5-10 hours to write and debug, maybe less depending on the complexity of the worksheets, and I'm a B- VBA programmer. I hope this helps in some way. Sorry I couldn't give you a concrete example.
 
Upvote 0
Blue_Elliott said:
So it's quite a lot of work, and unfortunately I don't have time to give you a thorough example (unfortunate because it's an interesting problem), but if you have some fluency with programming VBA here's how I would do it:

Step 1: you can either drop all the data into separate worksheets manually, or, depending upon how you get the flat files, write some code to call each workbook and automatically paste the data into a new sheet on your pivot table sheet.

Step 2: Make a pivot table sheet with the headings you want at the top

Step 3: using a series of loops and case statements, test the headings on each worksheet of data and if the headings match a heading on your pivot sheet, copy and paste the data to the end of your data on the pivot sheet. This will involve heavy use of offset, as well as dynamic range definition using the end.xl family of functions.

Step 4: Again using dynamic ranges, insert a pivot table based upon your pivot data.

This would probably take me about 5-10 hours to write and debug, maybe less depending on the complexity of the worksheets, and I'm a B- VBA programmer. I hope this helps in some way. Sorry I couldn't give you a concrete example.
Click to expand...


NP, appreciate the response, I'm not too good at VBA so im not sure I can do that ha ha - wasn't sure how complex of an issue it was. IN my first file i have the VBA to stack the data for 2 columns, i was just wondering if there was an easy way to convert that VBA to stack data for 3 columns, or 4. I's really just a question of moving data around and stacking it, so that i can then run a pivot on that data if i want to - but first i want to get it into that format.
 
Last edited:
Upvote 0
Blue_Elliot (others) -

What about this - I attached a file that might be easier to understand (http://www.sendspace.com/file/gdn2f5).

I have separate months of financial information that are formatted the exact same in each tab. I want to combine it into 1 worksheet and stack the data. I found VBA that does this, but it doesn't bring over the date into a separate column which is what i need for trending/pivoting purpose.

I put the code below, and i attached the file so you can see the output. I also put another tab "whatiwant" - as you can see the only thing that is missing is the date (it's not being stacked to the right in a separate column). I was hoping there would be an easy way to get that date over to the right when i run the code so I don't have to manually do it. Any thoughts?

Code: 
ub PivotTableFormat()
    Dim wrk As Workbook 'Workbook object - Always good to work with object variables
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Master Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets
     
    Set wrk = ActiveWorkbook 'Working in active workbook
     
    For Each sht In wrk.Worksheets
        If sht.Name = "Master" Then
            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
            "Please remove or rename this worksheet since 'Master' would be" & _
            "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
            Exit Sub
        End If
    Next sht
     
     'We don't want screen updating
    Application.ScreenUpdating = False
     
     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
     'Rename the new worksheet
    trg.Name = "Pivot"
     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column
     'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 1).Resize(1, colCount)
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value
         'Set font as bold
        .Font.Bold = True
    End With
     
     'We can start loop
    For Each sht In wrk.Worksheets
         'If worksheet in loop is the last one, stop execution (it is Pivot worksheet)
        If sht.Index = wrk.Worksheets.Count Then
            Exit For
        End If
         'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
        Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
         'Put data into the Pivot worksheet
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    Next sht
     'Fit the columns in Master worksheet
    trg.Columns.AutoFit
     
     'Screen updating should be activated
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Okay, so I couldn't quite get the dates to work yet, but I'm intrigued enough I've spent some time. If you use the last example spreadsheet you posted, delete your 'what I get' and 'what I want' sheets and run this code:

Code: 
Sub tryThisOut()

Dim dataSheet As Worksheet


' Add a data worksheet and add the titles
Worksheets.Add().Name = "PivotData"

Worksheets("PivotData").Range("a1").Value = "GL"
Worksheets("PivotData").Range("b1").Value = "Description"
Worksheets("PivotData").Range("c1").Value = "Amount"
Worksheets("PivotData").Range("d1").Value = "Date"

Dim pivotTitles As Range
Set pivotTitles = Worksheets("PivotData").Range("A1:A4")

For Each dataSheet In ActiveWorkbook.Worksheets
    dataSheet.Activate
    If dataSheet.Name <> "PivotData" Then
        Dim dataTitles As Range
        Set dataTitles = Range(Range("a1"), Range("a1").End(xlToRight))
        Dim cell As Range
        dataTitles.Select
           
            
                If IsEmpty(Worksheets("Pivotdata").Range("A2")) = True Then
                    
                For Each cell In dataTitles
                    
                    Select Case cell.Value
                    Case "GL":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("A2").Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case "Description":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("B2").Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case Is > 1:
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("C2").Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    End Select
                    
                    Next
                    
                    
                
                Else
                
                For Each cell In dataTitles
                    Select Case cell.Value
                    Case "GL":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("A1").End(xlDown).Offset(1, 0).Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case "Description":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("B1").End(xlDown).Offset(1, 0).Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case Is > 1:
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("C1").End(xlDown).Offset(1, 0).Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    End Select
                Next
                End If
            
            
            
    End If
    



Next




End Sub

That seems to pull most of the data together. It's setup so that it should run even if you have extraneous columns, though I haven't tested that yet. As for the dates, it should be a relatively simple matter of adding the data once for each record you cut and paste, but I can't really play with it any more today. Hope this helps.
 
Upvote 0
Blue_Elliott said:
Okay, so I couldn't quite get the dates to work yet, but I'm intrigued enough I've spent some time. If you use the last example spreadsheet you posted, delete your 'what I get' and 'what I want' sheets and run this code:

Code: 
Sub tryThisOut()

Dim dataSheet As Worksheet


' Add a data worksheet and add the titles
Worksheets.Add().Name = "PivotData"

Worksheets("PivotData").Range("a1").Value = "GL"
Worksheets("PivotData").Range("b1").Value = "Description"
Worksheets("PivotData").Range("c1").Value = "Amount"
Worksheets("PivotData").Range("d1").Value = "Date"

Dim pivotTitles As Range
Set pivotTitles = Worksheets("PivotData").Range("A1:A4")

For Each dataSheet In ActiveWorkbook.Worksheets
    dataSheet.Activate
    If dataSheet.Name <> "PivotData" Then
        Dim dataTitles As Range
        Set dataTitles = Range(Range("a1"), Range("a1").End(xlToRight))
        Dim cell As Range
        dataTitles.Select
           
            
                If IsEmpty(Worksheets("Pivotdata").Range("A2")) = True Then
                    
                For Each cell In dataTitles
                    
                    Select Case cell.Value
                    Case "GL":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("A2").Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case "Description":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("B2").Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case Is > 1:
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("C2").Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    End Select
                    
                    Next
                    
                    
                
                Else
                
                For Each cell In dataTitles
                    Select Case cell.Value
                    Case "GL":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("A1").End(xlDown).Offset(1, 0).Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case "Description":
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("B1").End(xlDown).Offset(1, 0).Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    Case Is > 1:
                        cell.Select
                        Range(ActiveCell.Offset(1, 0), ActiveCell.End(xlDown)).Select
                        Selection.Copy
                        Worksheets("PivotData").Activate
                        Range("C1").End(xlDown).Offset(1, 0).Select
                        ActiveSheet.Paste
                        dataSheet.Activate
                    End Select
                Next
                End If
            
            
            
    End If
    



Next




End Sub

That seems to pull most of the data together. It's setup so that it should run even if you have extraneous columns, though I haven't tested that yet. As for the dates, it should be a relatively simple matter of adding the data once for each record you cut and paste, but I can't really play with it any more today. Hope this helps.
Click to expand...

Thanks for the time, appreciate all the help! I think my only things that i need help updating in the vba code is:

1. if there is a blank in the amount column the vba stops stacking the data - can we make it so it pulls over blanks too?

2. how do we bring over the dates also.
 
Last edited:
Upvote 0
shawzito said:
Thanks for the time, appreciate all the help! I think my only things that i need help updating in the vba code is:

1. if there is a blank in the amount column the vba stops stacking the data - can we make it so it pulls over blanks too?

2. how do we bring over the dates also.
Click to expand...

I know I haven't fixed the dates, I described a method but I can't really spare the time to do it.

About the blanks: that's tough.You could find out how many entries are in the column and then set the range equal to that value, but otherwise you just need to not have blanks. That could be a separate set of code, replace null values with zeros (which is really easy).
 
Upvote 0
Blue_Elliott said:
I know I haven't fixed the dates, I described a method but I can't really spare the time to do it.

About the blanks: that's tough.You could find out how many entries are in the column and then set the range equal to that value, but otherwise you just need to not have blanks. That could be a separate set of code, replace null values with zeros (which is really easy).
Click to expand...

No problem, if you ever have time, just let me know. Would greatly appreciate it.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
Stacked Chart to show value and status YTD
Replies
2
Views
318
neilo1969
N
L
  • Solved
Code in excel VBA to refresh SAS tables instead of pivot tables
Replies
2
Views
121
Luigiportucale
L
divster27
  • Question
Creating a table to help remove duplicates
2
Replies
14
Views
193
divster27
divster27
F
  • Question
Pivot Tables and Porcentages
Replies
1
Views
116
GraH
GraH
N
  • Solved
Add data to column chart so that it becomes a stacked column chart
Replies
2
Views
351
Nick70
N

Forum statistics

Threads
1,215,327
Messages
6,124,281
Members
449,149
Latest member
mwdbActuary

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top