Need to replace formulas with code

[RAJESH1960]

Hello guys,

With the help of a code, I have this result data in sheet B from column A to G in a vertical order. Columns K:BD contain formulas to sort the data horizontally as shown in the image. As the formulas are too lengthy and in thousands of cells, the code takes a lot of time in calculating threads. To reduce the time taken for the macro to get the result, I was hoping somebody willing to help me to write a code to get the result from column A to G to Columns K:BD.

Shared Test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ	BA	BB	BC	BD
1											COPY THE RESULT AND PASTE TO NEW SHEET WITH PASTE SPECIAL - VALUES
2	Date	Vch Type	Vch No.	Narration	Particulars	Debit Negative	Credit Positive		Total Amt		Date	Vch Type	Vch No.	Narration	Ledger 1	Amt	Ledger 2	Amt	Ledger 3	Amt	Ledger 4	Amt	Ledger 5	Amt	Ledger 6	Amt	Ledger 7	Amt	Ledger 8	Amt	Ledger 9	Amt	Ledger 10	Amt	Ledger 11	Amt	Ledger 12	Amt	Ledger 13	Amt	Ledger 14	Amt	Ledger 15	Amt	Ledger 16	Amt	Ledger 17	Amt	Ledger 18	Amt	Ledger 19	Amt	Ledger 20	Amt	Ledger 21	Amt
3	02-08-2021	Receipt	1026		ICICI	-16380.00			-16380		02-08-2021	Receipt	1026		ICICI	-16380	January	4823	February	11720	March	-163
4	02-08-2021	Receipt	1026		January		4823.00		4823		03-08-2021	Receipt	1027		ICICI	-2000	January	1000	January	1000
5	02-08-2021	Receipt	1026		February		11720.00		11720		03-08-2021	Receipt	1028		ICICI	-2770	January	2800	February	-30
6	02-08-2021	Receipt	1026		March	-163.00			-163		04-08-2021	Payment	1029		ICICI	1062	Sunday	-944	Monday	-118
7	03-08-2021	Receipt	1027		ICICI	-2000.00			-2000		04-08-2021	Receipt	1030		ICICI	-1704	Monday	984	Tuesday	720
8	03-08-2021	Receipt	1027		January		1000.00		1000		04-08-2021	Payment	1031		ICICI	94572	Monday	-94612	Tuesday	40
9	03-08-2021	Receipt	1027		January		1000.00		1000				0			0
10	03-08-2021	Receipt	1028		ICICI	-2770.00			-2770							0
11	03-08-2021	Receipt	1028		January		2800.00		2800
12	03-08-2021	Receipt	1028		February	-30.00			-30
13	04-08-2021	Payment	1029		ICICI		1062.00		1062
14	04-08-2021	Payment	1029		Sunday	-944.00			-944
15	04-08-2021	Payment	1029		Monday	-118.00			-118
16	04-08-2021	Receipt	1030		ICICI	-1704.00			-1704
17	04-08-2021	Receipt	1030		Monday		984.00		984
18	04-08-2021	Receipt	1030		Tuesday		720.00		720
19	04-08-2021	Payment	1031		ICICI		94572.00		94572
20	04-08-2021	Payment	1031		Monday	-94612.00			-94612
21	04-08-2021	Payment	1031		Tuesday		40.00		40
B

 

[RAJESH1960]

Your example shows 6 rows so how about:

    Dim ColumnOffset    As Long, RowNumber  As Long
    Dim FormulaLooper   As Long
'
    ColumnOffset = 0
    RowNumber = 3
'
    For RowNumber = 3 To RowNumber + 6
        Range("K" & RowNumber).Offset(, ColumnOffset).Formula = "=IFERROR(INDEX($A$3:$I$2000,MATCH($M" & RowNumber & ",$C$3:$C$2000,0),1),"""")"
        Range("K" & RowNumber).Offset(, ColumnOffset + 1).Formula = "=IFERROR(INDEX($A$3:$I$2000,MATCH($M" & RowNumber & ",$C$3:$C$2000,0),2),"""")"
        Range("K" & RowNumber).Offset(, ColumnOffset + 2).FormulaArray = "=IFERROR(INDEX($C$3:$C$2000,MATCH(0,COUNTIF($M$2:$M" & RowNumber - 1 & ",($C$3:$C$2000)),0)),"""")"
        Range("K" & RowNumber).Offset(, ColumnOffset + 3).Formula = "=IF(IFERROR(INDEX($A$3:$I$2000,AGGREGATE(15,6,(ROW($C$3:$C$2000)-ROW($C$2))/($C$3:$C$2000=$M" & RowNumber & "),INT((COLUMNS(N" & RowNumber + 1 & ":$O" & RowNumber + 1 & ")+1)/2)),4),"""")="""","""")"
        Range("K" & RowNumber).Offset(, ColumnOffset + 4).Formula = "=IF(M" & RowNumber & "="""","""",IFERROR(INDEX($A$3:$I$2000,AGGREGATE(15,6,(ROW($C$3:$C$2000)-ROW($C$2))/($C$3:$C$2000=$M" & RowNumber & "),INT((COLUMNS(O" & RowNumber + 1 & ":$O" & RowNumber + 1 & ")+1)/2)),5),""""))&"""""
'
'
        For FormulaLooper = 5 To 45 Step 2
            Range("K" & RowNumber).Offset(, ColumnOffset + FormulaLooper).Formula = "=IF(M" & RowNumber - 1 & "="""","""",IFERROR(INDEX($A$3:$I$2000,AGGREGATE(15,6,(ROW($C$3:$C$2000)-ROW($C$2))/($C$3:$C$2000=$M" & RowNumber & "),INT((COLUMNS($O" & RowNumber & ":" & Range("K" & RowNumber).Offset(, ColumnOffset + FormulaLooper).Address(0, 0) & ")+1)/2)),9),""""))"
        Next
'
        For FormulaLooper = 6 To 44 Step 2
            Range("K" & RowNumber).Offset(, ColumnOffset + FormulaLooper).Formula = "=IF(M" & RowNumber - 1 & "="""","""",IFERROR(INDEX($A$3:$I$2000,AGGREGATE(15,6,(ROW($C$3:$C$2000)-ROW($C$2))/($C$3:$C$2000=$M" & RowNumber & "),INT((COLUMNS($O" & RowNumber + 1 & ":" & Range("K" & RowNumber).Offset(1, ColumnOffset + FormulaLooper).Address(0, 0) & ")+1)/2)),5),""""))&"""""
        Next
    Next

Let me know if there is any issue with that.

It is displaying the result of 7 rows correctly and in no time - 5 seconds

 

[Michael M]

As mentioned in another thread...import the data...find the last row then copy the formulas down to that found last row !!

 

[johnnyL]

So far so good?

 

[RAJESH1960]

Can you add to the code something like this.? In a help lcolumn, select voucher no. columns, remove duplicates, count the number of rows with value and then fill down as many rows.

 

[RAJESH1960]

So far so good?

very good man.

 

[johnnyL]

Ok, if all is good thus far, you probably want to store results into array and then when done, print results to sheet.

 

[RAJESH1960]

Ok, if all is good thus far, you probably want to store results into array and then when done, print results to sheet.

When done, I want to copy the data from K:BD to another sheet by using paste special and remove the values from the empty cells using this code. But first fill down the columns K:BD then .....

With ActiveSheet.UsedRange
   .Value = .Value

 

[johnnyL]

If you use an array to store the values, you won't need to do all of that.

.value = .value is used to remove formulas. If you store the values into the array, there is no need to do that.

 

[johnnyL]

I'm going to have to comment the previous code so I can see exactly what it was doing, and then work this code into it. I will do that tomorrow hopefully!

 

[RAJESH1960]

If you use an array to store the values, you won't need to do all of that.

I'm going to have to comment the previous code so I can see exactly what it was doing, and then work this code into it. I will do that tomorrow hopefully!

Okay sure JohnnyL. See you soon.