Solved

Optimise Excel VBA Loop

Posted on 2011-02-27
28
385 Views
Last Modified: 2012-05-11
I have written the below reasonably simple code to iterate through and combine data from a couple of sheets into the format I am after for export.

  Unfortunately it takes just under a second for each line, and I have 15000 lines.  I have used all of my usual optimization standards but cannot seem to speed it up.

Need some suggestions to rewrite/improve.  I am extremely familiar with VBA and comfortable with all concepts - looking for wiser heads than mine.

Sub Convert_data()
' Converts Genesys Data to the correct format for loading
'
' 20110225 - Created by Nigel Rablin
'
Dim Genesys_region As Range
Dim Cell As Variant
Dim Lastrow As Long
Dim i As Long
    Lastrow = Sheets("Genesys Raw").Range("C1000000").End(xlUp).Row
    Set Genesys_region = Sheets("Genesys Raw").Range("C3:C" & Lastrow)
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Sheets("Converted Data").Range("A4:Z1000000").ClearContents
    For Each Cell In Genesys_region
        On Error GoTo Errorhandler
            If Cell.Value <> Prevvalue Then
                matrixrow = Application.WorksheetFunction.Match(Trim(Cell.Value), Sheets("Matrix Raw").Range("M1:M999"), 0)
            End If
            Prevvalue = Cell.Value
        On Error GoTo 0
        team_code = Sheets("Matrix Raw").Range("I" & matrixrow).Value
        With Sheets("Converted Data").Range("C" & (i + 4))
            .Offset(0, 0).Value = Sheets("Matrix Raw").Range("C" & matrixrow).Value
            .Offset(0, 1).Value = Sheets("Matrix Raw").Range("L" & matrixrow).Value
            .Offset(0, 2).Value = Sheets("Matrix Raw").Range("K" & matrixrow).Value
            .Offset(0, 3).Value = Sheets("Matrix Raw").Range("M" & matrixrow).Value
            .Offset(0, 4).Value = Trim(Cell.Value)
            .Offset(0, 6).Value = Sheets("Matrix Raw").Range("F" & matrixrow).Value
            .Offset(0, 7).Value = Cell.Offset(0, 1)
            .Offset(0, 8).Value = UCase(Format(Cell.Offset(0, 1), "ddd"))
            .Offset(0, 9).Value = Cell.Offset(0, 2)
            .Offset(0, 10).Value = Cell.Offset(0, 1) + Cell.Offset(0, 3)
            .Offset(0, 11).Value = Cell.Offset(0, 1) + Cell.Offset(0, 4)
            .Offset(0, 12).Value = Cell.Offset(0, 5) * 24 * 60
            .Offset(0, 15).Value = team_code
            .Offset(0, 16).Value = Application.WorksheetFunction.VLookup(team_code, Sheets("Matrix Raw").Range("R:S"), 2, False)
        End With
      
    i = i + 1
    Next Cell
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub
Errorhandler:
    matrixrow = 3434
    Resume Next
End Sub

Open in new window

0
Comment
Question by:Makrini
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 13
  • 6
  • 5
  • +2
28 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 34993472
I suspect this line may be the problem:

   .Offset(0, 16).Value = Application.WorksheetFunction.VLookup(team_code, Sheets("Matrix Raw").Range("R:S"), 2, False)

Try commenting it out and running a test.

Kevin
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993486
Thanks Kevin,

  That was in fact my first thought too.  No perceptable improvement when I did that unfortunately.

Quite possibly I need to think of a way without looping at all
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 34993495
Do you have any event handlers such as Worksheet_Change?

If so then try adding:

   Application.EnableEvents = False
   ...
   Application.EnableEvents = True

Kevin
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 50

Accepted Solution

by:
Dave Brett earned 500 total points
ID: 34993510
I don't know about wiser, perhaps prior necessity :)

Use Arrays, not ranges
http://www.experts-exchange.com/A_2684.html

It looks like you need
1) a 6 column, variable row length array for Gensys_region (as you use a 5 colum offset later)
2) lookup matrixrow as per your current code ( matrixrow = Application.WorksheetFunction.Match(Trim(Cell.Value), Sheets("Matrix Raw").Range("M1:M999"), 0))
3) a 17 column variable row length array to dump to  Sheets("Converted Data").Range("C" & (i + 4))

If you have trouble then a sample file would help, but I think you will be ok implementing the array approach based on my article example

As per now you have a read range and output range
The arrays simply sit inside these two ranges and do the work
Cheers

Dave






0
 
LVL 10

Author Comment

by:Makrini
ID: 34993516
   

  Again great thinking, but no, I have no events running.  There are two dynamic queries that run before this Macro, but I have turned them off and am simply running this Macro in isolation on just data.
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993521
That could do the trick Dave,

  I'll give it a shot and do some rewrites.  Thanks - will keep you up to date
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 34993542
My code in the create CSV article is may be a better reference for array manipulation - it shows how to transpose columns and rows

http://www.experts-exchange.com/A_3509.html

@Kevin,

I've fixed my blackberry. Still at Hilton but I'm free till 8 (aussie / new zealand catchup) if you are around somewhere / thinking dinner etc

Cheers
Dave
0
 
LVL 33

Expert Comment

by:Norie
ID: 34993549
What's the purpose of your error handler?

Is it a problem with a specific row/value?

What is the error you are trying to catch?

As it is the code looks like the error handler code will be executed whatever the error is.

Oh, and what's the code actually meant to do?:)
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993550
I keep forgetting you are Aussie...

I am in Brisbane
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993561
The error Handler can be turned off, it basically sets a value for if the match is not found.  

The plan for the error handler is to push out trash data into a separate sheet.

It will also only fire for that one line and I am comfortable for every error in that section to be piped elsewhere.

The code simply loops through some data and looks for a match in the "Username" in a different data set.  - It then pulls data from the relevant sheet for the information it is after.
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 34993567
I only picked that up 10 mins ago when I saw the Queensland timezone on your question. i hope you came the flooding unscathed.

Today though I'm in not so sunny Seattle, bit of a shock compared to Melbourne
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993588
  I was all good in the floods.  My workplace was evacuated, but I basically work from my laptop through a wireless connection anyway, so I evacuated early and worked from my balcony watching the chaos
0
 
LVL 33

Expert Comment

by:Norie
ID: 34993600
Sorry but I don't see how that error handling will only be triggered by an error in a specific row or a specific type of error.

If you know when the error will happen why even use an error handler, couldn't it be dealt with a simple If.
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993639
On Error GoTo Errorhandler 
            If Cell.Value <> Prevvalue Then 
                matrixrow = Application.WorksheetFunction.Match(Trim(Cell.Value), Sheets("Matrix Raw").Range("M1:M999"), 0) 
            End If 
            Prevvalue = Cell.Value 
        On Error GoTo 0 

Open in new window


 On error Goto 0 will actually turn normal error handling back on.  So my Error Handler only happens on the lines of code above.  The performance detriment for that line is almost non existant.

 I know the error will appear here if it cannot fid a match.  Normally I would use VBA find, but it does not work in this instance due to differing character types.  
0
 
LVL 42

Expert Comment

by:dlmille
ID: 34993783
One thing I do when I have a lot of spreadsheet lookup, references, and math going on, is to paste the FORMULA (rather than value) on the first line, then one command copies that formula down a # of rows, and the last step to convert all formulas to values.  It would be a quick thing to test and see if this helps before wrapping your head around a completely different approach (which may be the correct way, but I'm just saying :)

So you could Turn Calculations OFF, and do something like the below for all rows, or leave Calculations ON and do it for one row, copy down, then set formulas to values:            

            .Offset(0, 0).Formula = "='Matrix Raw'!C" & Matrixrow
            .Offset(0, 1).Formula = "='Matrix Raw'!L" & Matrixrow
            .Offset(0, 2).Formula = "='Matrix Raw'!K" & Matrixrow
            .Offset(0, 3).Formula = "='Matrix Raw'!M" & Matrixrow

Since Cell is a vlookup output, you could code that formula in as well.  You could do this for one row of output, then copy down the entire range.  Alternatively (may or may not be a timesaver) you could plow all the formulas in with calculations off, then...

Then turn calculation on, select your output range and set selection.value = selection.value

One very quick way to test is to manually set the formulas in the range of cells, turn calc off, then copy down, then turn calc on.  Did that process much faster or not?
Enjoy!

Dave
For Each Cell In Genesys_region
        On Error GoTo Errorhandler
            If Cell.Value <> Prevvalue Then
                matrixrow = Application.WorksheetFunction.Match(Trim(Cell.Value), Sheets("Matrix Raw").Range("M1:M999"), 0)
            End If
            Prevvalue = Cell.Value
        On Error GoTo 0
        team_code = Sheets("Matrix Raw").Range("I" & matrixrow).Value
        With Sheets("Converted Data").Range("C" & (i + 4))
            .Offset(0, 0).Value = Sheets("Matrix Raw").Range("C" & matrixrow).Value
            .Offset(0, 1).Value = Sheets("Matrix Raw").Range("L" & matrixrow).Value
            .Offset(0, 2).Value = Sheets("Matrix Raw").Range("K" & matrixrow).Value
            .Offset(0, 3).Value = Sheets("Matrix Raw").Range("M" & matrixrow).Value
            .Offset(0, 4).Value = Trim(Cell.Value)
            .Offset(0, 6).Value = Sheets("Matrix Raw").Range("F" & matrixrow).Value
            .Offset(0, 7).Value = Cell.Offset(0, 1)
            .Offset(0, 8).Value = UCase(Format(Cell.Offset(0, 1), "ddd"))
            .Offset(0, 9).Value = Cell.Offset(0, 2)
            .Offset(0, 10).Value = Cell.Offset(0, 1) + Cell.Offset(0, 3)
            .Offset(0, 11).Value = Cell.Offset(0, 1) + Cell.Offset(0, 4)
            .Offset(0, 12).Value = Cell.Offset(0, 5) * 24 * 60
            .Offset(0, 15).Value = team_code
            .Offset(0, 16).Value = Application.WorksheetFunction.VLookup(team_code, Sheets("Matrix Raw").Range("R:S"), 2, False)
        End With
      
    i = i + 1
    Next Cell

Open in new window

0
 
LVL 42

Expert Comment

by:dlmille
ID: 34993786
Ignore the attached code in my prior post.  I was going to do something with it, then decided on a simple example.  Sorry for any confusion.

Dave
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993801
Hi Dave,

  I am in the middle of coding a multidimensional array method.  Appears to be quite good so far, just looking for a way to find a match in the array - assuming use of filter at the moment.

  I like it so far

Makrini
0
 
LVL 42

Expert Comment

by:dlmille
ID: 34993887
Great - go for it!

Dave
0
 
LVL 10

Author Comment

by:Makrini
ID: 34993892
So far I have below.   Now to create an array to put the data into, instead of directly to sheet.

So far it appears a lot faster - the next step should show significant improvement

Sub Array_test()
    Dim Genesys_Data(), Matrix_Data(), MatrixList()
    
    Lastrow = Sheets("Genesys Raw").Range("C1000000").End(xlUp).Row
    Set Genesys_region = Sheets("Genesys Raw").Range("C3:J" & Lastrow)
    Genesys_Data = Genesys_region.Value2
    MatrixList = Sheets("Matrix Raw").Range("M1:M999").Value
    Matrix_Data = Sheets("Matrix Raw").Range("C1:M999").Value2
    
    For lngrow = 1 To Genesys_region.Rows.Count
    thevalue = Trim(Genesys_Data(lngrow, 1))
    If thevalue <> oldvalue Then
        On Error Resume Next
        matrixrow = WorksheetFunction.Match(thevalue, MatrixList, 0)
        On Error GoTo 0
        oldvalue = thevalue
    End If
    If matrixrow > 0 Then
        team_code = Sheets("Matrix Raw").Range("I" & matrixrow).Value
        With Sheets("Converted Data").Range("C" & (i + 4))
            .Offset(0, 0).Value = Matrix_Data(matrixrow, 1)
            .Offset(0, 1).Value = Matrix_Data(matrixrow, 10)
            .Offset(0, 2).Value = Matrix_Data(matrixrow, 9)
            .Offset(0, 3).Value = Matrix_Data(matrixrow, 11)
            .Offset(0, 4).Value = thevalue
            .Offset(0, 6).Value = Matrix_Data(matrixrow, 4)
            .Offset(0, 7).Value = Genesys_Data(lngrow, 2)
            .Offset(0, 8).Value = UCase(Genesys_Data(lngrow, 2))
            .Offset(0, 9).Value = Genesys_Data(lngrow, 3)
            .Offset(0, 10).Value = Genesys_Data(lngrow, 2) + Genesys_Data(lngrow, 4)
            .Offset(0, 11).Value = Genesys_Data(lngrow, 2) + Genesys_Data(lngrow, 5)
            .Offset(0, 12).Value = Genesys_Data(lngrow, 6) * 24 * 60
            '.Offset(0, 15).Value = team_code
            '.Offset(0, 16).Value = Application.WorksheetFunction.VLookup(team_code, Sheets("Matrix Raw").Range("R:S"), 2, False)
        End With
        i = i + 1
    Else
        ' No match
    End If

    Next
    
End Sub

Open in new window

0
 
LVL 42

Expert Comment

by:dlmille
ID: 34993906
Perhaps also try to Turn calculations off (assuming you're just pasting values)...

Dave
0
 
LVL 10

Author Comment

by:Makrini
ID: 34994018
Ok - so how do I get it *out* of the array?

Last couple of rows - trying to output the array output_data

Sub Import_data()
' 1. Converts GENESYS Schedule State Report (XLS format) into MATRIX eWFM (CSV format)
' 2. Creates SHIFT and ADHRS container codes for MATRIX processing
' 3. Writes records to CSV file
'
' 20110223 - Created by Stephen Cockram
' 20110224 - Added Comments
'
Dim connectString, dirName, fileDate As String
Dim Filename As Variant
    
    Filename = Application.GetOpenFilename()
    If Filename = 0 Then
        MsgBox ("Cancelled")
        Exit Sub
    End If
    
    dirName = Left(Filename, InStrRev(Filename, "\"))
    ' filedate = Mid(Filename, 29, 8)
    fileDate = "20110217"
    
    connectString = "ODBC;DSN=Excel Files;DBQ=" & Filename & ";DefaultDir=" & dirName & ";DriverId=790;MaxBufferSize=2048;PageTimeout=5;"
    
    Application.Calculation = xlCalculationManual
    With Sheets("Genesys Raw").Range("A3").ListObject.QueryTable
        .Connection = connectString
        .Refresh
    End With
    
    With Sheets("MATRIX Raw")
        .Range("A2").ListObject.QueryTable.Refresh
        .Range("R2").ListObject.QueryTable.Refresh
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Call Convert_data
     ' **** CREATE subroutine to remove unknown agents  ****
    Call Savethecsv(fileDate)
    
End Sub

Sub Array_test()
    Dim Genesys_Data(), Matrix_Data(), MatrixList(), output_data()
    i = 1
    Lastrow = Sheets("Genesys Raw").Range("C1000000").End(xlUp).Row
    Set Genesys_region = Sheets("Genesys Raw").Range("C3:J" & Lastrow)
    Genesys_Data = Genesys_region.Value2
    MatrixList = Sheets("Matrix Raw").Range("M1:M999").Value
    Matrix_Data = Sheets("Matrix Raw").Range("C1:M999").Value2
    
    For lngrow = 1 To Genesys_region.Rows.Count
    thevalue = Trim(Genesys_Data(lngrow, 1))
    If thevalue <> oldvalue Then
        On Error Resume Next
        matrixrow = WorksheetFunction.Match(thevalue, MatrixList, 0)
        On Error GoTo 0
        oldvalue = thevalue
    End If
    If matrixrow > 0 Then
        team_code = Matrix_Data(matrixrow, 7)
       
            ReDim Preserve output_data(16, i)
            output_data(1, i) = Matrix_Data(matrixrow, 1)
            output_data(2, i) = Matrix_Data(matrixrow, 10)
            output_data(3, i) = Matrix_Data(matrixrow, 9)
            output_data(4, i) = Matrix_Data(matrixrow, 11)
            output_data(5, i) = thevalue
            output_data(6, i) = Matrix_Data(matrixrow, 4)
            output_data(7, i) = Genesys_Data(lngrow, 2)
            output_data(8, i) = UCase(Genesys_Data(lngrow, 2))
            output_data(10, i) = Genesys_Data(lngrow, 3)
            output_data(11, i) = Genesys_Data(lngrow, 2) + Genesys_Data(lngrow, 4)
            output_data(12, i) = Genesys_Data(lngrow, 2) + Genesys_Data(lngrow, 5)
            output_data(13, i) = Genesys_Data(lngrow, 6) * 24 * 60
            '.Offset(0, 15).Value = team_code
            '.Offset(0, 16).Value = Application.WorksheetFunction.VLookup(team_code, Sheets("Matrix Raw").Range("R:S"), 2, False)
        Debug.Print i
        i = i + 1
    Else
        ' No match
    End If

    Next
    Debug.Print "End"
    output_data = Application.Transpose(output_data)
    Sheets("Converted_Data").Range("C4").Resize(UBound(output_data), UBound(Application.Transpose(output_data))) = output_data
   

Open in new window

0
 
LVL 10

Author Comment

by:Makrini
ID: 34994066
Never mind - I'm an idiot - put a "_" in the sheet name is all


Thank you so very much for your help - this is like 1000 times faster!
0
 
LVL 10

Author Closing Comment

by:Makrini
ID: 34994070
Superb and I learned a LOT
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 34994484
Glad to have helped :)

Dave
0
 
LVL 42

Expert Comment

by:dlmille
ID: 34994635
This was a really neat exercise.  Thanks Dave, as always for the lesson!

the "other" Dave :)
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 34994711
:)

and thx both for the article votes
0
 
LVL 10

Author Comment

by:Makrini
ID: 34995068
You deserve it.  I am always impressed by the likes of you and rorya etc
0
 
LVL 42

Expert Comment

by:dlmille
ID: 34999540
Agreed - very enlightening article - can't wait to turn your tips into real practice/knowledge.

Dave
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

735 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question