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!):