SPEED UP YOUR VBA RunTime!

WOW!  I just found a nice little help that improved my vba run time from 30 minutes to less than 1 minute!

So, I had a bit of VBA that I wrote to clean up and group a transaction level data set from a 3rd party report.  I noticed that on average it was taking up to FOUR seconds per row to clean, identify, re-organize, validate for duplicate entries, and write to a new table.  Essentially, 600 rows would take at least 30 minutes for the vba code to complete its task.  I have NEVER run into this issue before - Turning off Screen Updating has resolved any issues with speed I've had up until this point.

30 minutes just won't do.

So, I went hunting for solutions.  But, before I can solve the problem, I had to FIND the problem.

What is the problem?  Well, I found through the use of breakpoints where the lag in time was.  It was taking up to 3 seconds to simply place a batch of values that were stored in variables into empty cells. 

example line: 

Sheets("Converted").Cells(Rowc, 1).Value = Location

The issue was that Excel was recalculating the sheet every time a new value was placed in a cell.  So, how do we stop that? 

At the beginning of your vba code (probably right along with your line to deactivate screen updating) insert the following line:

Application.Calculation = xlCalculationManual

Then, at the bottom right before you end sub, insert the line:

Application.Calculation = xlCalculationAutomatic

BINGO!  Problem solved.

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

VBA Tip for the day: Screen Updating

VBA - Screen Updating.

Have you ever created a macro that bounces between spreadsheets and causes the screen to flash because it's trying to keep up with the macro switching worksheets?  Well, there's a quick fix for that:

Option Explicit
Sub StopFlashing()
Application.ScreenUpdating = False

[Your code Here]

Application.ScreenUpdating = True
End Sub

This will not only stop the screen from flashing and causing your users to have seizures, but it will also help to optimize the macro and allow it to run faster!