Help Me Speed This Code Up

[Grasor]

Hi all,

For practice I like to program overbuilt spreadsheets for useless causes. Below is a part of one of them.

Despite turning off screen updating and calculations this still runs extremely slow.

So far this code is only having to handle about 600 "rows" of data; and frankly it's not that much data - only 6 entries per line. Yet it takes about a full 1min30s to build the array and post the result. That's just slow; particularly because I plan on expanding the amount of data to interpret to thousands of rows.

There has to be a faster way. Any ideas?

P.S. +1 to anyone who can name the application that I'm dealing with.

Type AssetsArray
    TypeID As String
    ItemName As String
    LocationID As String
    Container As String
    Quantity As Long
    Value As Variant
End Type

Sub CalculateAssets()

'This sub calculates assets list on demand.  It supercedes in-sheet coding which has proven heavy on processing.
'Future upgrade notes: Function to return Station name instead of location ID.

Dim rXMLMap As Range
Dim lRow, i As Long
Dim AssetsXML() As AssetsArray

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Debug.Print Time

Set rXMLMap = Range(Range("I23"), Range("I100000").End(xlUp))
ReDim AssetsXML(0 To rXMLMap.Rows.Count)
lRow = 23

'Build Array of Pertinent Values from XML Map
For i = 0 To UBound(AssetsXML)
    bIsContents = IIf(Range("U" & lRow) = "contents", True, False)
    With AssetsXML(i)
        .TypeID = IIf(bIsContents = True, MyAssets.Range("Y" & lRow), MyAssets.Range("P" & lRow))
        .ItemName = FindMktID(.TypeID, "ItemName")
        .LocationID = MyAssets.Range("O" & lRow)
        .Container = IIf(bIsContents = False, "Station", FindMktID(MyAssets.Range("P" & lRow), "ItemName"))
        .Quantity = MyAssets.Range("Q" & lRow)
        .Value = FindMktID(.TypeID, "MktValue")
    End With
    lRow = lRow + 1
Next i

'Reset lRow to first row in table
lRow = 23

'Post Array to Spreadsheet
For i = 0 To UBound(AssetsXML)
    With AssetsXML(i)
        Range("A" & lRow) = .TypeID
        Range("B" & lRow) = .ItemName
        Range("C" & lRow) = .LocationID
        Range("D" & lRow) = .Container
        Range("E" & lRow) = .Quantity
        Range("F" & lRow) = .Value
    End With
    lRow = lRow + 1
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Debug.Print Time

End Sub


Function FindMktID(TypeID As String, FindWhat As String) As String

Dim rCell, rMarketIDs As Range
Dim btOffset As Byte

btOffset = IIf(FindWhat = "ItemName", 1, IIf(FindWhat = "MktValue", 2, 1)) 'If FindWhat Arg is "ItemName" offset 1, If "MktValue" offset 2.

Set rMarketIDs = MktValue.Range(MktValue.Range("A1"), MktValue.Range("A100000").End(xlUp))

For Each rCell In rMarketIDs
    On Error GoTo NextCell
    If rCell.Value = TypeID Then
        FindMktID = rCell.Offset(0, btOffset)
    End If
NextCell:
Next rCell

End Function

 

[mikerickson]

This section can be sped up by eliminating unneeded calculations

'Build Array of Pertinent Values from XML Map
For i = 0 To UBound(AssetsXML)
    bIsContents = (Range("U" & lRow) = "contents")
    With AssetsXML(i)
        .TypeID = IIf(bIsContents, MyAssets.Range("Y" & lRow), MyAssets.Range("P" & lRow))
        .ItemName = FindMktID(.TypeID, "ItemName")
        .LocationID = MyAssets.Range("O" & lRow)
        .Container = IIf(bIsContents, FindMktID(MyAssets.Range("P" & lRow), "ItemName"), "Station")
        .Quantity = MyAssets.Range("Q" & lRow)
        .Value = FindMktID(.TypeID, "MktValue")
    End With
    lRow = lRow + 1
Next i

 

[mikerickson]

You also might change

Function FindMktID(TypeID As String, FindWhat As String) As String
    Dim rMarketIDs As Range
    Dim btOffset As Byte

    btOffset = 1
    If FindWhat = "MktValue" Then
        btOffset = 2
    End If

    Set rMarketIDs = MktValue.Range(MktValue.Range("A1"), MktValue.Range("A100000").End(xlUp))

    FindMktID = Application.VLOOKUP(TypeID, rMarektIDs, btOffset + 1, False)

End Function

 

[Grasor]

Mike,

You may be right. I assumed the "slow" part was actually the posting of the array to the sheet. However, when I added a 3rd Debug.Print Time command directly after the completion of array construction my timings were as follows for 575 rows.

Start Procedure: 1:26:53 AM
Finish Building Array: 1:28:08 AM
Complete Transfer of Array to Sheet: 1:28:09 AM
There were this many entries: 552

So the posting of the array only takes a second.

I found that if I commented out the .ItemName, .Container. and .Value lines which all call the FindMktID() function my times reduced drastically to...well instantly.

Start Procedure: 1:33:03 AM
Finish Building Array: 1:33:03 AM
Complete Transfer of Array to Sheet: 1:33:03 AM
There were this many entries: 552

The function does perform a search of some 28,000 rows to locate the proper ID and then return the data it needs - much like a VLOOKUP() function would.

So let's attack this:

I wanted to stay away from the VLOOKUP function because I knew this could be done faster just using what is available in VBA (or at least as fast) and as part of educating myself I sought another way around that. For the record. Excel's built-in functions will almost always be faster than anything we can come with in VBA. Programming your own Vlookup will likely be much slower (as I have I just demonstrated).

I decided that polling through a sheet each round was going to slow me down. So I added a 2nd array to contain all the values that were found on the MktValue worksheet and stuffed them all in there from the get go. Then I adjusted the FindMktID function to use the array instead of polling through the worksheet. This was much MUCH faster. See times below.

Start Procedure: 2:32:27 AM
Finish Building Market Data Array: 2:32:27 AM
Finish Building XML Data Array: 2:32:30 AM
Complete Transfer of Array to Sheet: 2:32:30 AM
There were this many entries: 552

So I went from 1m16 seconds to 03 seconds. Not bad.

Learning Point: When using large data sets in an Excel sheet it is best to ingest the entire table into an array. I prefer user-defined type arrays for this as they are easier to work with.



Thanks for suggesting I take a second look at my code. I needed that.
-G

Type AssetsArray
    TypeID As String
    ItemName As String
    LocationID As String
    Container As String
    Quantity As Long
    Value As Variant
End Type


Type MarketIDArray
    TypeID As String
    TypeName As String
    JitaSell As Variant
End Type
'Declare MarketID array public so that it can be accessed by all procedures/functions in this module w/o having to be passed.
Public MarketID() As MarketIDArray


Sub CalculateAssets()


'This sub calculates assets list on demand.  It supercedes in-sheet coding which has proven heavy on processing.
'Future upgrade notes: Function to return Station name instead of location ID.


Dim rXMLMap As Range
Dim rMarketIDTable As Range
Dim lRow, i As Long
Dim AssetsXML() As AssetsArray


'Turn off Calulation and Screenupdating for expediency
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Debug.Print "Start Procedure: " & Time


'Set AssetsXML Array Upper Boundary
With MyAssets
    Set rXMLMap = .Range(.Range("I23"), .Range("I100000").End(xlUp))
End With
ReDim AssetsXML(0 To rXMLMap.Rows.Count)


'Set MktValue Array Upper Boundary
With MktValue
    Set rMarketIDTable = .Range(.Range("A2"), .Range("A100000").End(xlUp))
End With
ReDim MarketID(0 To rMarketIDTable.Rows.Count)


'Reset lRow to first row in MktValue Worksheet Table
lRow = 1


'Build Array Containing Market ID Information
For i = 0 To UBound(MarketID)
    With MarketID(i)
        .TypeID = MktValue.Range("A" & lRow)
        .TypeName = MktValue.Range("B" & lRow)
        .JitaSell = MktValue.Range("C" & lRow)
    End With
    lRow = lRow + 1
Next i


Debug.Print "Finish Building Market Data Array: " & Time


'Build Array of Pertinent Values from XML Map
lRow = 23
For i = 0 To UBound(AssetsXML)
    bIsContents = IIf(Range("U" & lRow) = "contents", True, False)
    With AssetsXML(i)
        .TypeID = IIf(bIsContents = True, MyAssets.Range("Y" & lRow), MyAssets.Range("P" & lRow))
        .ItemName = FindMktID(.TypeID, "ItemName")
        .LocationID = MyAssets.Range("O" & lRow)
        .Container = IIf(bIsContents = False, "Station", FindMktID(MyAssets.Range("P" & lRow), "ItemName"))
        .Quantity = MyAssets.Range("Q" & lRow)
        .Value = FindMktID(.TypeID, "MktValue")
    End With
    lRow = lRow + 1
Next i


Debug.Print "Finish Building XML Data Array: " & Time


lRow = 23
'Post Array to Spreadsheet
For i = 0 To UBound(AssetsXML)
    With AssetsXML(i)
        Range("A" & lRow) = .TypeID
        Range("B" & lRow) = .ItemName
        Range("C" & lRow) = .LocationID
        Range("D" & lRow) = .Container
        Range("E" & lRow) = .Quantity
        Range("F" & lRow) = .Value
    End With
    lRow = lRow + 1
Next i


Debug.Print "Complete Transfer of Array to Sheet: " & Time


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


Debug.Print "There were this many entries: " & lRow - 23


End Sub


Function FindMktID(TypeID As String, FindWhat As String) As String


Dim i As Long
For i = 0 To UBound(MarketID)
    With MarketID(i)
        If .TypeID = TypeID Then
            If FindWhat = "ItemName" Then
                FindMktID = .TypeName
            Else
                FindMktID = .JitaSell
            End If
        End If
    End With
Next i


End Function

 

[mikerickson]

I wanted to stay away from the VLOOKUP function because I knew this could be done faster just using what is available in VBA (or at least as fast) and as part of educating myself I sought another way around that. For the record. Excel's built-in functions will almost always be faster than anything we can come with in VBA. Programming your own Vlookup will likely be much slower (as I have I just demonstrated).

Faster than a loop, but not VLookup, would be using the .Find command

MsgBox rMarketIDs.Find(what:= TypeId).Offset(0,btOffset).Value