Need to replace formulas with code

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
856
Office Version
  1. 2019
Platform
  1. Windows
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
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBD
1COPY THE RESULT AND PASTE TO NEW SHEET WITH PASTE SPECIAL - VALUES
2DateVch TypeVch No.NarrationParticularsDebit NegativeCredit PositiveTotal AmtDateVch TypeVch No.NarrationLedger 1AmtLedger 2AmtLedger 3AmtLedger 4AmtLedger 5AmtLedger 6AmtLedger 7AmtLedger 8AmtLedger 9AmtLedger 10AmtLedger 11AmtLedger 12AmtLedger 13AmtLedger 14AmtLedger 15AmtLedger 16AmtLedger 17AmtLedger 18AmtLedger 19AmtLedger 20AmtLedger 21Amt
302-08-2021Receipt1026ICICI-16380.00-1638002-08-2021Receipt1026ICICI-16380January4823February11720March-163
402-08-2021Receipt1026January4823.00482303-08-2021Receipt1027ICICI-2000January1000January1000
502-08-2021Receipt1026February11720.001172003-08-2021Receipt1028ICICI-2770January2800February-30
602-08-2021Receipt1026March-163.00-16304-08-2021Payment1029ICICI1062Sunday-944Monday-118
703-08-2021Receipt1027ICICI-2000.00-200004-08-2021Receipt1030ICICI-1704Monday984Tuesday720
803-08-2021Receipt1027January1000.00100004-08-2021Payment1031ICICI94572Monday-94612Tuesday40
903-08-2021Receipt1027January1000.00100000
1003-08-2021Receipt1028ICICI-2770.00-27700
1103-08-2021Receipt1028January2800.002800
1203-08-2021Receipt1028February-30.00-30
1304-08-2021Payment1029ICICI1062.001062
1404-08-2021Payment1029Sunday-944.00-944
1504-08-2021Payment1029Monday-118.00-118
1604-08-2021Receipt1030ICICI-1704.00-1704
1704-08-2021Receipt1030Monday984.00984
1804-08-2021Receipt1030Tuesday720.00720
1904-08-2021Payment1031ICICI94572.0094572
2004-08-2021Payment1031Monday-94612.00-94612
2104-08-2021Payment1031Tuesday40.0040
B
 

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
856
Office Version
  1. 2019
Platform
  1. Windows
Your example shows 6 rows so how about:

VBA Code:
    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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
21,179
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
As mentioned in another thread...import the data...find the last row then copy the formulas down to that found last row !!
 

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
856
Office Version
  1. 2019
Platform
  1. Windows
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.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,095
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Ok, if all is good thus far, you probably want to store results into array and then when done, print results to sheet.
 

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
856
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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 .....
Rich (BB code):
With ActiveSheet.UsedRange
   .Value = .Value
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,095
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
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

Well-known Member
Joined
Nov 7, 2011
Messages
2,095
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
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!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,962
Messages
5,767,342
Members
425,404
Latest member
Bairkus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top