Your question, your audience. Choose who sees your identity—and your question—with question security.

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.

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
```

.Offset(0, 16).Value = Application.WorksheetFunct

Try commenting it out and running a test.

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

If so then try adding:

Application.EnableEvents = False

...

Application.EnableEvents = True

Kevin

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.

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

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

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

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.

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

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

```
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
```

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.

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

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
```

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

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
```

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
```

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.

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.WorksheetFunct

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