Ideas on Speeding up macro execution

[uksrogers]

Hi there,

We have a fairly complicated macro in Excel which we have used in our system for a number of years. In the most part it works fairly well, but there is a certain situation where it is much slower than i would like. I am wondering if anyone has any suggestions as to how i might improve performance a bit.

I have attached a sample csv output and an example of what it looks like after the macro has done it's stuff.

The methodology the macro uses at the moment is to import the data into a temporary worksheet and then move through, row at a time, using a rather large select statement to do what it needs to, based on the code in the first column.

What really seems to slow things down is when it is applying colour and border styles to the cells. These are applied based on the rows starting CL and LI and at the moment are processed cell at a time.

I did get a long way into putting something together that would do a sum on the CL and CT lines, store it in an array along with the address of the cell and then copy and paste the formatting when it found a row with a similar sum. Unfortunately i never managed to get this working entirely successfully as it would copy lines that weren't required.

I have turned off things like screen updating and auto calc.

If anyone has any thoughts on ways i might be able to improve things i would be really pleased to hear them!

uksrogers

[matthewspatrick]

uksrogers,

Without seeing the actual code, I cannot say for sure. However, here is a partial list of things you might want to do to speed things up:

• Stop using Select and Activate methods. They are almost never necessary, and they slow down your execution significantly. You mention that you are using this now
• Where possible, use array transfers instead of constantly interrogating and/or writing to range objects. This can increase your speed tremendously. Array transfers can work for both input and output
• Turn off screen updating while the code executes
• Unless you absolutely need it to be automatic while the code runs (unusual), set the calc mode to manual while the code is executing, and then switch back to automatic at the end
• Instead of using long trains of Object.Child.Child.Child etc., use object variables
• In If blocks, structure them so that the most likely outcome is listed first, if possible

Other contributors will doubtless come up with other ideas, but these are always worth trying if you are dissatisfied with the current performance.

[uksrogers]

Patrick,

Many thanks for your response on this.

I think i may have been a little unclear in my description when i mentioned i use a big select statement. To go into a little more detail, once the csv files is opened in a new worksheet, the macro reads down the sheet a line at a time (without using selects, or activates) and reads the value in the first column. Then based on that value it does a "select case rowvalue". This determines what should be done with the rest of the row. This can be anything from setting column justification (JF in the example) to specifying the worksheet name (TA), orientation (OR) or even a blank line (BL).

When you mention Array transfers, do you mean copying the data into an array and then processing that as opposed to the raw data? If you do then i may well have tried that but ran into problems when dumping the data back into the worksheet as a result of the different data types that are involved.

Regards

uksrogers

[johnske]

I'll echo what MattewsPatrick plus for his last item change If blocks to Select Case statements where possible (Select Case is faster when there are a large number of cases and your case may be near to the last one) also, read Optimizing your code for some more ideas...

[uksrogers]

Thanks for the link... looks like there is some stuff in there i can get my teeth in to.

One part that i think could be slowing things down is when it processes the lines that add the borders and shading. (CL, CT and LI in the example provided)

Does anyone know if it is possible to create or define an object that contains details of cell colour and borders which can then be applied to a range using a single command?

TIA

uksrogers

[matthewspatrick]

Does anyone know if it is possible to create or define an object that contains details of cell colour and borders which can then be applied to a range using a single command?

If you use PasteSpecial, you can paste the formatting for a single cell to any number of other cells, without messing with the values...

[uksrogers]

Patrick,

Again thanks for the reply... but this is what i was i mentioned in my original post that i couldn't get working. The trouble is that say row 5 has borders to the left and right, but nothing top and bottom. Then row 6 applies a top border for example. When i came across another row that required similar formatting to row 5 it would copy the left and right borders correctly, but would also include the top border of row 6. I even tried inserting a blank row above and below before it copied, but it still didn't resolve it!!

From my testing, this method does give significantly better performance... but the output in certain circumstances is incorrect.

Regards

uksrogers

[mdmackillop]

A few things to fix, but this should get you on the way

[vba]
Option Explicit
Dim w, c As Range, firstaddress As String

Sub FixIt()
Application.ScreenUpdating = False
Sheets("output").Copy Before:=Sheets(1)
Columns(1).Delete
With Columns(1)
For Each w In Array("Release", "Person", "Date")
.Find(what:=w, after:=[A1], lookat:=xlPart).Offset(, 20) = "x"
Next
For Each w In Array("Mon", "Tue", "Wed", "Thu", "Fri")
Set c = .Find(what:=w, lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Set c = .FindNext(c)
c.Offset(, 20) = "x"
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
Next
End With
Cells.AutoFilter Field:=21, Criteria1:="="
Intersect(ActiveSheet.UsedRange, _
Cells.SpecialCells(xlCellTypeVisible)).EntireRow.Delete
Set c = Nothing
DoFormat
Borders
Application.ScreenUpdating = True
End Sub

Sub DoFormat()
With Range([A4], [B65536].End(xlUp)).Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
With Range("A1:G1").Font
.Size = 12
.Bold = True
End With
Range("A2:I2").Font.Italic = True
With Range("A3:K3")
.Interior.ColorIndex = 41
.Font.Bold = True
.Font.ColorIndex = 2
End With
With Columns(1)
Set c = .Find(what:="Fri", lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Offset(1).EntireRow.Insert
c.Range("A2:K2").Interior.ColorIndex = 36
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
Set c = Nothing
End Sub

Sub Borders()
Set c = Range([A4], [B65536].End(xlUp))
c.Borders.LineStyle = xlContinuous
c.Borders(xlInsideVertical).LineStyle = xlNone
Set c = Nothing
End Sub[/vba]

[Ivan F Moala]

   
 a.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic

should take care of

With a.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With 
    With a.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With 
    With a.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With 
    With a.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With

[mdmackillop]

Thanks Ivan,
I'd been telling myself there should be a better way.
Regards
MD

[debauch]

I found this b4 when looking to optimize code within large data worksheets.
It is pretty good; easy to follow and will help prevent crashes as well. I have not tested this against colors/bordors though.
[vba]
Private Sub mUpdateSuchAndSuch()
' This involves updating a sheet of complicated formulas.
' Each updated formula will cause a recalculation, so we


' want to turn calculation off until we are done, then let
' the whole thing recalculate at once.

Dim rngActiveCell As Range ' Remember where the user was.
Dim wsCalcSheet As Worksheet ' where we have to make big changes
Dim wbCalcSheet As Workbook ' Can't assume it's ActiveWorkbook

' Remember where the user is
If Not ActiveCell Is Nothing Then
Set rngActiveCell = ActiveCell
End If

' We might have to switch screens, so turn off screen updating
' so user you don't get headache
Application.ScreenUpdating = False

' Turn off calc temporarily
Application.Calculation = xlCalculationManual

' We shouldn't assume the workbook
' we need is open, so check for error
On Error Resume Next
Set wbCalcSheet = Workbooks(mMYTOOL)
If Err.Number > 0 Then
On Error GoTo 0
Err.Raise vbObjectError, "mUpdateSuchAndSuch", "Required workbook is not open."
End If
On Error GoTo 0

' Is the active workbook the same one?
If Not ActiveWorkbook Is Nothing Then
If ActiveWorkbook.Name <> wbCalcSheet.Name Then
' Perhaps we have to Activate it (may not be
' necessary depending on what you're doing)
wbCalcSheet.Activate
End If
Else
wbCalcSheet.Activate
End If

' Is the active sheet the one we need?
On Error Resume Next
Set wsCalcSheet = wbCalcSheet.Worksheets(mCALCSHEET)
If Err.Number > 0 Then
On Error GoTo 0
Err.Raise vbObjectError, "mUpdateSuchAndSuch", "Required worksheet not available."
End If
On Error GoTo 0
If Not ActiveSheet Is Nothing Then
If ActiveSheet.Name <> wsCalcSheet.Name Then
' Activate it (if necessary)
wsCalcSheet.Activate
End If
Else
wsCalcSheet.Activate
End If

[/vba]

[mdmackillop]

uksrodgers,
I don't know if you wanted anything done with your csv data, but it can probably be handled in some way, if you have rules for its incorporation.

[uksrogers]

Oh yeah... the part that i submitted is only a small section of the whole as it goes...

I need to go away now and spend some time trying to implement some of the ideas to see if i can get some improvement in performance. I am going to look at using autofilters in line with the code you suggested as i think this could be a potential winner, along with some of the suggestions in the link posted by johnske.

Would just like to thank everyone that took the time to respond to this post.

uksrogers