Can we change complex excel formula into VBA-CodePudding

Can anyone please write this formula in VBA code, this is making the sheet heavy and whenever i add or edit raw data (Data sheet) it starts "Calculating 4 processors" and takes much time.

In raw Data Sheet there are almsot 18000 entries and in other sheet where i am extracting the status contains 8000 entries, however it would be much helpful if it sees till the last raw.

=IF(SUMPRODUCT((Data!$A$2:$A$17989=A7076)(Data!$B$2:$B$17989=B7076)(Data!$C$2:$C$17989="Combine")),"Available",IF(COUNTIFS(Data!$A$2:$A$17989,A7076,Data!$B$2:$B$17989,B7076,Data!$C$2:$C$17989,"Feed *")=2,"Available","Not Available"))

I have read many articles on web and tried them but not helpful and i am wondering if VBA is one of the best solution for this complex formula.

what i have recorded is below:

Sub Macro1() ' ActiveCell.FormulaR1C1 = _

    "=IF(SUMPRODUCT((Data!R2C1:R17989C1=RC[-5])*(Data!R2C2:R17989C2=RC[-4])*(Data!R2C3:R17989C3=""Combine"")),""Available"",IF(COUNTIFS(Data!R2C1:R17989C1,RC[-5],Data!R2C2:R17989C2,RC[-4],Data!R2C3:R17989C3,""Feed *"")=2,""Available"",""Not Available""))"

Range("F2").Select

Selection.Copy

Range("F3:F7076").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Selection.End(xlUp).Select

Range("F3").Select

ActiveWorkbook.Save

End Sub

thank you

CodePudding user response：

Please, test the next solution. Activate the sheet to be processed and run SetAvailability:

Sub SetAvailability()
   Dim sh As Worksheet, shD As Worksheet, lastRA As Long, lastRD As Long, arrD, arr, arrF, i As Long
   
   Set sh = ActiveSheet
   Set shD = Worksheets("Data")
    lastRA = sh.Range("A" & sh.rows.count).End(xlUp).Row
    lastRD = shD.Range("A" & shD.rows.count).End(xlUp).Row
    
    arrF = sh.Range("F2:F" & lastRA).Value2
    arr = sh.Range("A2:B" & lastRA).Value2
    arrD = shD.Range("A2:C" & lastRD).Value2
    
    For i = 1 To UBound(arr)
        arrF(i, 1) = getAvailability(arrD, arr(i, 1), arr(i, 2), "Combine", "Feed *")
    Next i
    
    'drop the processed aray content at once:
    sh.Range("F2").Resize(UBound(arrF), 1).Value2 = arrF
    
    MsgBox "Ready..."
End Sub

Function getAvailability(arrD, strAA, strBB, strAv As String, strFeed As String) As String
   Dim countFeed As Long, i As Long
   For i = 1 To UBound(arrD)
        If arrD(i, 1) = strAA And UCase(arrD(i, 2)) = UCase(strBB) Then
            If UCase(arrD(i, 3)) = UCase(strAv) Then getAvailability = "Available": Exit Function
            If arrD(i, 3) Like strFeed Then countFeed = countFeed   1
            If countFeed = 2 Then getAvailability = "Available": Exit Function
        End If
   Next i
   getAvailability = "Not Available"
End Function

It should be fast enough, working only in memory and dropping the processed array content at once, at the end of the code. And, no any workbook charge because of complicated formula...

The above solution assumes that strings as "Feed *" will be at least two, for matchings in A:A and B:B, meaning that more (than two) such matches are allowed to consider the return as "Available".

It will take some time, anyhow, but I am curious how match for your specific data ranges.

It will be faster if the availability is bigger (the iteration on "Data" sheet array stops after finding the match...).