Using VBA to Reformat a Report

This post is going to be somewhat short and sweet - I'm not going to explain every little part, but I will provide a demo file for you to play with.

The Problem:
A report from a 3rd party vendor can only be exported to Microsoft Word is very pretty and in a table-like format.  However, each individual data point was contained in what appeared to be a textbox. Therefore, when attempting to copy paste the results into excel, all headers, footers, and data points are in their own cell, but in the same column.

Example of pasting report in cell A1:

**Note: I have changed ALL of the data and this report does NOT reflect anything real.

The Solution:

My mind immediately went to VBA for the solution this time.  Here are a few concepts that you need to know about to accomplish this task:

• Option Explicit - always use this to ensure all variables are declared
• Screen Updating - I use this to keep the screen from flashing when switching sheets and to make the macro run faster
• Do until Loop - This is used to step down the worksheet row-by-row until a certain condition is met
• Select Case - This is like a big IF/Then statement. 

When I create a "Formatting" macro, I like to have one spreadsheet for the original "pasted" format, and worksheet for the result after the macro runs.  This allows you to quickly, visually compare original vs new to validate accuracy of your code. 

The Code:

Simplified Explanation:  The macro looks at each populated row looking for the department name.  Once found, it gathers the information for that departments encounter and then places it in a more tabular format on the "Final" worksheet. It will do this until the "LastRow" (assigned by counting the populated rows) is evaluated.

Option Explicit

Sub Reorganize()

Dim row As Variant, lastrow As Variant, Dept As Variant, Isle As Variant, ID As Variant, CartoonAccount As Variant, CartoonName As Variant, Order As Variant, Row1 As Integer

Application.ScreenUpdating = False

Sheets("Paste").Activate

lastrow = ActiveSheet.UsedRange.Rows.Count

row = 1

Do Until row = lastrow

    If row >= lastrow Then Exit Do

    Select Case Cells(row, 1).Value

        Case Is = "Health"

            Dept = Cells(row, 1).Value

            Isle = Cells(row + 1, 1).Value

            ID = Cells(row + 2, 1).Value

            Order = Cells(row + 3, 1).Value

            CartoonName = Cells(row + 4, 1).Value

            CartoonAccount = Cells(row + 5, 1).Value

                

                    Sheets("Final").Activate

                        Row1 = 2

                        Do Until Cells(Row1, 1).Value = ""

                            If Cells(Row1, 1).Value = "" Then Exit Do

                            Row1 = Row1 + 1

                        Loop

                        

                        Sheets("Final").Cells(Row1, 1).Value = Dept

                        Sheets("Final").Cells(Row1, 2).Value = Isle

                        Sheets("Final").Cells(Row1, 3).Value = ID

                        Sheets("Final").Cells(Row1, 4).Value = Order

                        Sheets("Final").Cells(Row1, 5).Value = CartoonName

                        Sheets("Final").Cells(Row1, 6).Value = CartoonAccount

                        Row1 = 2

                        Sheets("Paste").Activate

                        row = row + 1

                                     

        Case Is = "FurnitureDept"

            Dept = Cells(row, 1).Value

            Isle = Cells(row + 1, 1).Value

            ID = Cells(row + 2, 1).Value

            Order = Cells(row + 3, 1).Value

            CartoonName = Cells(row + 4, 1).Value

            CartoonAccount = Cells(row + 5, 1).Value

                

                    Sheets("Final").Activate

                        Row1 = 2

                        Do Until Cells(Row1, 1).Value = ""

                            If Cells(Row1, 1).Value = "" Then Exit Do

                            Row1 = Row1 + 1

                        Loop

                        

                        Sheets("Final").Cells(Row1, 1).Value = Dept

                        Sheets("Final").Cells(Row1, 2).Value = Isle

                        Sheets("Final").Cells(Row1, 3).Value = ID

                        Sheets("Final").Cells(Row1, 4).Value = Order

                        Sheets("Final").Cells(Row1, 5).Value = CartoonName

                        Sheets("Final").Cells(Row1, 6).Value = CartoonAccount

                        Row1 = 2

                        Sheets("Paste").Activate

                        row = row + 1

        Case Is = "Toys"

            Dept = Cells(row, 1).Value

            Isle = Cells(row + 1, 1).Value

            ID = Cells(row + 2, 1).Value

            Order = Cells(row + 3, 1).Value

            CartoonName = Cells(row + 4, 1).Value

            CartoonAccount = Cells(row + 5, 1).Value

                

                    Sheets("Final").Activate

                        Row1 = 2

                        Do Until Cells(Row1, 1).Value = ""

                            If Cells(Row1, 1).Value = "" Then Exit Do

                            Row1 = Row1 + 1

                        Loop

                        

                        Sheets("Final").Cells(Row1, 1).Value = Dept

                        Sheets("Final").Cells(Row1, 2).Value = Isle

                        Sheets("Final").Cells(Row1, 3).Value = ID

                        Sheets("Final").Cells(Row1, 4).Value = Order

                        Sheets("Final").Cells(Row1, 5).Value = CartoonName

                        Sheets("Final").Cells(Row1, 6).Value = CartoonAccount

                        Row1 = 2

                        Sheets("Paste").Activate

                        row = row + 1

        Case Else

            row = row + 1

    End Select

Loop

Application.ScreenUpdating = True

Sheets("Final").Activate

End Sub

I LOVE VBA - What can I say, it was my first programming language.. I'm self-taught so if you are an expert and have a better way to accomplish this, feel free to contribute to the conversation!  Again, we're here to learn together- from each other.  

Demo File (Does Contain Macros!): 

Rolling 12 Months Chart

I know I haven't posted in a while... I've been crazy busy with work, moving, and life in general.. But things are settling down and I hope to get back on track.

Recently I was asked to create a chart that could function as a "rolling 12 months" chart.  If using Power Pivot in Excel 2010 or 2013, this would have been quick and easy using a date/time dimension table to slice the data.  However, this needed to be supported in Excel 2007.  Soooo, I had to get creative.

Here is what I came up with -

Specific formulas needed:
=EDATE(start date, months)
=VLOOKUP(Lookup value, table array, col_index_num, [range_lookup])

To begin, we have our data set:

This is simply a random data set that I generated for this example with no true significance in the real world... Note: The dates in column "A" were entered as "6/1/2012" and then formatted within the cell to only show month/year.  I always use the first day of the month when working with month-year formats.  Not sure if this is best practice, but it is my own standard since there is always a day "1" in every month.

Next, I created a table that will show the 12 months' data:

Above the table I simply added "Last Month" and "Last Year" fields for data entry.  These will be used by formulas within the table.  The numbers in the yellow cells are manually entered/changed - although I suppose you could use a data validation drop-down if you wanted to limit what could be entered.

Anyway, Here's how I created the table:
In the bottom left cell of the table ("Jun-14") I added the formula: =DATE(I1, G1, 1) where G1 is the value entered in the yellow cells for "Last Month" and I1 is the value entered in the other yellow cell for "Last Year" - Last month and Last year meaning the last month/year you wish to be shown on the chart.

In the cell above the "Jun-14" cell, I use the formula: =EDATE(F14,-1) where F14 is the date that we just created in the bottom left cell of the table, and "-1" tells excel to subtract 1 month.

I simply continue or "Auto-Fill" the formula to the top of the table.  Now, when you change the date parts in the yellow cells, the dates in the table will automatically adjust.

Next, we use a vlookup formula to go and gather the data that corresponds with the date in the first column of the table. By using the "dynamic" dates we've created, our data will also be dynamically selected from the original data set. - Since I've addressed vlookup in past posts, I'll skip this part.  I will post a snapshot of the table showing the formulas at the end though.

The last column in the table is simply a preference.  I create the numerator/denominator for the data label on the chart.  I do this simply by concatenating the values using this formula: =H3&"/"&I3 (this results in the value at the top right of the table: 1091/1100).  I find it very helpful to include the n/d when displaying percentages in a chart.  This shows the reader if 50% is 1/2 or 500/1000.

Final Snapshot of table showing formulas:

Last, I create a simple line chart using the "Month" and "Success%" columns in our table.  Add data labels to each of the data points on the chart.  To create dynamic chart data point labels simply click on an individual label, and in the formula bar type "=" and the cell reference of the value you are looking to display - In this case, the first label on the left would be =$J$3.

Since we created the table using relative references instead of specific numbers and values, when the Last Month and Last Year are changed at the top, the data in the table as well as the data on the chart are instantly updated to show the "rolling 12 months".

I know this was a bit rushed...  That's why I'm including an example file this time!  You can get it here.