I've got a rather complex formula at hand. So far, I've been using Range.Formula2R1C1, however it is painfully slow.

The original formula in ws.Cell (3, 14) are:

=TEXTJOIN(", ";TRUE;IF(IFERROR(MATCH(tblPO[PO_MAT];IF(B3=tblPO[PROJECT];tblPO[PO_MAT];"");0);"")=MATCH(ROW(tblPO[PO_MAT]);ROW(tblPO[PO_MAT]));tblPO[PO_MAT];""))

Code

Public Function WriteComplexFormulas()

    
    Dim ws As Worksheet, ws2 As Worksheet
    Set ws = ThisWorkbook.Worksheets("Orders")
    Set ws2 = ThisWorkbook.Worksheets("PO")
    
    
    Dim obj As ListObject
    Set obj = ws.ListObjects("tblOrders")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    
 
    ws.Cells(3, 14).Formula2R1C1 = "=TEXTJOIN("", "",TRUE,IF(IFERROR(MATCH(tblPO[PO_MAT],IF(RC[-12]=tblPO[PROJECT],tblPO[PO_MAT],""""),0),"""")=MATCH(ROW(tblPO[PO_MAT]),ROW(tblPO[PO_MAT])),tblPO[PO_MAT],""""))"

    
    For j = 1 To obj.DataBodyRange.Rows.Count
        ws.Cells(j   2, 14).Value = ws.Cells(j   2, 14).Value
    Next j
        
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Function

Table orders for one particular SO looks as follows:

The result of the current worksheet function returns all results in column 'PO_MAT' for each 'PROJECT' as a string: "RELAYXX1, RELAYXY2, RELAYXZ3"

Now, the reason for the longtime is of course the very resource-heavy formula. ws.cell(3,14) are the first cell in a table. The formula are thus written (autofilled) down to some 2500 rows of data. This takes processing time for sure.

I'm stuck as to how to proceed to make it run faster, as Application.Worksheetfunction does not have an "IF"-statement.

Any pointers on how I could replace this function with VBA? If of any help, I achieved the same result in Python:

def modifyDict(df):
        df['PROJECT'] = (df['SD_DOC']   '-'    df['SD_ITM'])
        df= df[['PROJECT', 'PO_MAT']]
       
        df = pd.DataFrame(df)
        dict_ = df.groupby('PROJECT')['PO_MAT'].agg(list).to_dict()

        keys_values = dict_.items()
        outputDict = {str(key): str(value) for key, value in keys_values}

        output = pd.DataFrame.from_dict(outputDict,orient='index').reset_index()
        output.columns = np.arange(len(output.columns))

        output.rename(index=str).index
        output.columns = ['PROJECT','PO_MAT']

        return output

To clarify the requirement

Desired result is a string, containing all matches for a given key in a table.

The two tables are:

Column 'Materials Ordered' illustrates the desired output: a concatenation of all values associated with each key found in the rightmost table, linked with the leftmost tables keys.

CodePudding user response：

Please, use the next solution. It should be very fast, using arrays, a dictionary and dropping the processed array content at once. It shouldn't be used as a UDF function (called from a cell). You should run the code as it is and it will bring what (I understood) is needed, in the appropriate table column:

Sub bringProjectsMaterials()
  Dim ws As Worksheet, ws2 As Worksheet, tblOrd As ListObject, tblPO As ListObject
  Dim arrPr1, arrPr2, arrO, arrMat, arrMatO, dict As Object, i As Long
  
  Set ws = ThisWorkbook.Worksheets("Orders")
  Set ws2 = ThisWorkbook.Worksheets("PO")
  Set tblOrd = ws.ListObjects("tblOrders")
  Set tblPO = ws2.ListObjects("tblPO")

  arrPr1 = tblOrd.ListColumns("PROJECT").DataBodyRange.Value2 'place the ranges in arrays, for faster iteration/processing
  arrPr2 = tblPO.ListColumns("PROJECT").DataBodyRange.Value2
  arrMat = tblPO.ListColumns("PO_MAT2").DataBodyRange.Value2
  
  'build the dictionary of unique orders in tblPO with PROJECT as keys and PO_MAT as strings to be returned
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(arrPr2)
        If Not dict.Exists(arrPr2(i, 1)) Then
           dict(arrPr2(i, 1)) = arrMat(i, 1)
        Else
            dict(arrPr2(i, 1)) = dict(arrPr2(i, 1)) & "," & arrMat(i, 1)
        End If
  Next i
  'fill the array to keep the processed result:
  ReDim arrMatO(1 To UBound(arrPr1), 1 To 1)
  For i = 1 To UBound(arrPr1)
        arrMatO(i, 1) = dict(arrPr1(i, 1))
  Next i
  'drop the processed array content in the necessary column:
   tblOrd.ListColumns("Materials Ordered").DataBodyRange.Value2 = arrMatO
End Sub
MsgBox "Ready..."