vba help - loop is very slow for record 70000

[Mallesh23]

Hi Team,

I have 70000 records I have to loop/Filter and update Responsibility and Remarks Columns.
By Checking all conditions. First two conditions are Reasons and Actionable if met
then check all notional Columns as per Conditions givens. IF Condition fulfilled I have to update Responsility and Remarks Columns.

in all Notional amounts there are formulas also there in actual Project... but it contain all notionals value either 0,>0, or <0.

In condition Criteria there are 9 criteria are added at the moment, But in actual there are 25 Conditions to check.

Every single conditions at least 4 to 6 columns cells to check.

Which method is best loop is very slow.... can we create dynamic Autofilter function here



Below is the Sample data ....Colum J and K to be fill. J and K Already filled . as per Criteria.

Book3
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Sr No	Outstanding Balance	Balance as per sap	Unallocated Payment	Unadjusted Claim	Qty	Claim Amount	QV	PV	Responsibility	Remark	Reasons	Actionables
2	1	0	0	100	100	100	100	100	100	ABC Company	Cleared	Collection Cleared	Fully allocated
3	1	0	0	100	100	100	100	100	100	ABC Company	Cleared	Collection Cleared	Fully allocated
4	2	250	75	100	100	100	100	100	100	PQ	To write Off	Collection Cleared	To be Write Off
5	2	-250	-100	100	100	100	100	100	100	PQ	To write Off	Collection Cleared	To be Write Off
6	3	0	300	100	100	100	100	100	100	ABC Company	Cleared	Collection Cleared	Excess Payment
7	4	1000	300	1000	111	700	100	333	111	CFA	POD Required- Mismatch in Quantity	Price, Qty, Claims Difference	Check with CFA for the Qty Mismatch
8	5	1000	1000	1000	222	1000	300	111	444	RB	Price Issue	Price, Qty, Claims Difference	Check with RB for PV Cases
9	6	1000	1000	1000	500	1000	300	333	444	RB	Unadjusted claims	Price, Qty, Claims Difference	Check with RB for PV Cases
10	7	1000	1000	1000	200	100	200	50	60	RB	Written off to Misc GL	Price, Qty, Claims Difference	CN to be Raised
11	8	250	0	1000	1000	1000	1000	1000	1000	ABC Company	Cleared	Collection Cleared	Written off to Misc GL
12	8	-250	0	1000	1000	1000	1000	1000	1000	ABC Company	Cleared	Collection Cleared	Written off to Misc GL
13	9	0	0	1000	1000	1000	1000	1000	1000	ABC Company	Cleared	Complete Reversal	Fully allocated
14	9	0	0	1000	1000	1000	1000	1000	1000	ABC Company	Cleared	Complete Reversal	Fully allocated
15	10	5000	500	1000	1000	1000	1000	1000	1000	Customer	In query with Customer	In Query	Check with Customer for details
Sheet2

Criteria to Check Responsibility and Remarks are .... Only 9 Criteria like that there are 24 Criteria.
Looking best way to handle with.......... First Two Criteria are Reasons and Actionable if met Check Conditions.

Debtors Macro Remark Condition (007).xlsx
	A	B	C	D	E
1	Reasons	Actionables	Condition	Responsibility	Remark
2	Collection Cleared	Fully allocated	O/s Balance and Bal as per SAP should be zero	ABC Company	Cleared
3	Collection Cleared	To be Write Off	O/s Balance and bal as per SAP as on Amount should be between + or – 250	PQ	To write Off
4	Collection Cleared	Excess Payment	O/s Balance should be 0 and unallocated payment amount is greater than 0	ABC Company	Cleared
5	Price, Qty, Claims Difference	Check with CFA for the Qty Mismatch	Qty Dispute is non zero, QV is greater thanPV and Unadjusted Claim	CFA	POD Required- Mismatch in Quantity
6	Price, Qty, Claims Difference	Check with RB for PPV Cases	PV is non zero, PV is greater than QV and Unadjusted Claim	RB	Price Issue
7	Price, Qty, Claims Difference	CN to be Raised	Unadjusted claims is non zero and it is greater than PV and QV	RB	Unadjusted claims
8	Collection Cleared	Written off to Misc GL	O/s Balance Amount should be between + or – 250 and bal as per SAP as on amount is Zero	RB	Written off to Misc GL
9	Complete Reversal	Fully allocated	O/s Balance and Bal as per SAP should be zero	ABC Company	Cleared
10	In Query	Check with Customer for details	O/s Balance and Bal as per SAP should be non zero	Price, Qty, Claims Difference	CN to be Raised
Criteria

Thanks
mg

 

[offthelip]

Try this code, it will very fast to run because I have loaded all the data into a variant array ( Alldata) and I am writing out to a varaint array ( outarr) . The condition for 5 ,6 and 7 I couldn't do because the data wasn't there in your example , but you see how it can easily be added. Also in your rule 2 , "O/s Balance and bal as per SAP as on Amount should be between + or – 250" however your test data has value of 250 in B4 and -250 in B5 , so both of these FAIL this test because they are not BETWEEN -250 and 250. I have added >= and =< to the equations on rule 2 to check it works correctly. ( But Not on rule 8)
You choose which you want.

Sub test()
With Worksheets("Criteria")
 crit = Range(.Cells(1, 1), .Cells(10, 6))
End With
With Worksheets("Sheet2")
 lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
 alldata = Range(.Cells(1, 1), .Cells(lastrow, 13))
 outarr = Range(.Cells(1, 10), .Cells(lastrow, 11))
 For i = 2 To lastrow
  ' loop through criteria
  updateRR = False
  For j = 2 To 10
   If crit(j, 1) = alldata(i, 12) And crit(j, 2) = alldata(i, 13) Then
     Select Case j
      Case 2, 9
       'O/s Balance and Bal as per SAP should be zero
       updateRR = alldata(i, 2) = 0 And alldata(i, 3) = 0
      Case 3
      'O/s Balance and bal as per SAP as on Amount should be between + or – 250
       updateRR = alldata(i, 2) >= -250 And alldata(i, 2) <= 250 And alldata(i, 3) >= -250 And alldata(i, 3) <= 250
      Case 4
      'O/s Balance should be 0 and unallocated payment amount is greater than 0
       updateRR = alldata(i, 2) = 0 And alldata(i, 4) > 0
       Case 5, 6, 7
       'Qty Dispute is non zero, QV is greater thanPV and Unadjusted Claim
       ' I don't know what QV and PV is!! Same with case 6 and 7
       Case 8
       'O/s Balance Amount should be between + or – 250 and bal as per SAP as on amount is Zero
       updateRR = alldata(i, 2) > -250 And alldata(i, 2) < 250 And alldata(i, 3) = 0
       Case 10
       'O/s Balance and Bal as per SAP should be non zero
        updateRR = alldata(i, 2) <> 0 And alldata(i, 3) <> 0
      End Select
    If updateRR Then
     outarr(i, 1) = crit(j, 4)
     outarr(i, 2) = crit(j, 5)
     Exit For
    End If
   End If
  Next j
 Next i
Range(.Cells(1, 10), .Cells(lastrow, 11)) = outarr
End With
 
 
End Sub

 

[Mallesh23]

Hi Offthelp,

Thanks for your help, I will modify remaining part and test it. ?



Thanks
mg

​