Identify Anonymous orders in BOM list & update accordingly, execute time is taking very long

Question

Right here, I'm trying to identify whether or not the demand order in my multi-level BOM list is made by an anonymous customer and then update accordingly.

-In laymens term, I'm checking if an item in the "BOM list sheet" is an anonymous order. If it is, match the item to the same item in "other sheet" & check whether there is an allocated supply. If no supply allocated, update the "other sheet" accordingly as anonymous, else do nothing. But I'm using arrays instead of worksheets.

1. aRow & bRow refers to current row.
2. value means current column.
3. = vbNullString means no supply allocated

  For aRow = 2 To UBound(mArray, 1)
   For bRow = LBound(dArray, 1) + 1 To UBound(dArray, 1) - 1
   

   If dArray(bRow, 15) = "issue SFC-anonymous" Or dArray(bRow, 15) = "issue PRP-anonymous" Then
    If mArray(aRow, 1) = dArray(bRow, 1) And mArray(aRow, 12) = vbNullString Then
       mArray(aRow, 12) = "Anonymous"
    End If
   ElseIf dArray(bRow, 15) = "add INV-PUR" Or dArray(bRow, 15) = "add INV-SFC" Then
       If mArray(aRow, 1) = dArray(bRow, 1) And mArray(aRow, 12) = vbNullString Then
          mArray(aRow, 12) = "Anonymous"
       End If
   End If

    Next bRow
    Next aRow

This code is working, but the time it takes to execute is taking about 4-5 minutes which is very long, I assume one reason for this might be because I'm working with string values.

Any advice/criticism to help me improve the code is highly appreciated.

Answer 1

1. The code cycles thru the remainder of dArray even after meeting the logic condition for setting an mArray element to 'Anonymous'. This is inefficient since replacing the vbNullString once is sufficient. Adding an Exit For statement after replacing the vbNullString value with 'Anonymous' will remove the inefficiency.

2. Regardless of the string comparisons, the condition for replacing the mArray value depends directly on the condition that mArray(aRow,12) = vbNullString. This is known prior to entering the dArray loop. Check for this condition and skip iterating thru the nested loop altogether if the condition is not met.

3. Regardless of the string comparisons, the condition for replacing the mArray value depends directly on mArray(aRow, 1) = dArray(bRow, 1). This is known the immediately after entering the dArray loop. If the condition is not met, skip any other checks in the iteration.

Also, it looks like there is no reason to have an If and ElseIf based on the code fragment provided.

Below is the code with the changes described above. Declarations have been added to make the fragment compile.

Sub Test()
    Dim aRow As Long
    Dim bRow As Long
    
    Dim dArray As Variant
    Dim mArray As Variant
    
    Dim toCheckFor As String
    
    For aRow = 2 To UBound(mArray, 1)
        If Not mArray(aRow, 12) = vbNullString Then
            For bRow = LBound(dArray, 1) + 1 To UBound(dArray, 1) - 1
                If mArray(aRow, 1) = dArray(bRow, 1) Then
                    toCheckFor = dArray(bRow, 15)
                    If toCheckFor = "issue SFC-anonymous" _
                        Or toCheckFor = "issue PRP-anonymous" _
                        Or toCheckFor = "add INV-PUR" _
                        Or toCheckFor = "add INV-SFC" Then
                        
                            mArray(aRow, 12) = "Anonymous"
                            Exit For
                    End If
                End If
    
            Next bRow
        End If
    Next aRow

End Sub

The changes above should improve performance. However, the code contains both nested loops and If statements. This makes the code very hard to read/understand and maintain. The code below eliminates the nested loop, improves readability, and will likely have an unnoticeable impact on performance.

Sub Test()
    Dim aRow As Long
    
    Dim dArray As Variant
    Dim mArray As Variant
    
    For aRow = 2 To UBound(mArray, 1)
        If Not mArray(aRow, 12) = vbNullString Then
            If MeetsConditionsToSetMArrayValue(dArray, mArray, aRow) Then
                mArray(aRow, 12) = "Anonymous"
                Exit For
            End If
        End If
    Next aRow

End Sub

Private Function MeetsConditionsToSetMArrayValue(ByRef dArray As Variant, _
    ByRef mArray As Variant, ByVal aRow As Long) As Boolean
    
    Dim bRow As Long
    For bRow = LBound(dArray, 1) + 1 To UBound(dArray, 1) - 1
        If mArray(aRow, 1) = dArray(bRow, 1) Then
            If ValueMeetsReplacementCriteria(dArray(bRow, 15)) Then
                MeetsConditionsToSetMArrayValue = True
                Exit Function
            End If
        End If
        
    Next bRow
    
    MeetsConditionsToSetMArrayValue = False
End Function

Private Function ValueMeetsReplacementCriteria(ByVal valueToCheck As String) As Boolean

    ValueMeetsReplacementCriteria = _
        valueToCheck = "issue SFC-anonymous" _
        Or valueToCheck = "issue PRP-anonymous" _
        Or valueToCheck = "add INV-PUR" _
        Or valueToCheck = "add INV-SFC"

End Function