Need to replace formulas with code

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
863
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
863
Office Version
  1. 2019
Platform
  1. Windows
What I am saying is both your hide and unhide code exempts the 'Original sheet, therefore it is always unhidden.

So why not use the the following for your unhidden block of code:
VBA Code:
Sub UnHideSheets()
    Dim WS As Worksheet
        For Each WS In ThisWorkbook.Worksheets
            WS.Visible = xlSheetVisible
        End If
    Next WS
End Sub

No need to check for it's name.
You mean to say that I can remove the 2 lines from unhide sheets
Rich (BB code):
If WS.Name <> "Original" Then
end if
Hide sheets should be as it is. Right?
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
863
Office Version
  1. 2019
Platform
  1. Windows
In future, I will add another unhidden sheet to enter the rules and steps to follow to run this workbook. So, I will have to keep 2 sheets open at all times - Original and Steps to follow. That time I will have to change the code once again.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,103
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
yes

VBA Code:
Sub UnHideSheets()
    Dim WS As Worksheet
    For Each WS In ThisWorkbook.Worksheets
        WS.Visible = xlSheetVisible
    Next
End Sub
 

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
863
Office Version
  1. 2019
Platform
  1. Windows
What I am saying is both your hide and unhide code exempts the 'Original sheet, therefore it is always unhidden.

So why not use the the following for your unhidden block of code:
VBA Code:
Sub UnHideSheets()
    Dim WS As Worksheet
        For Each WS In ThisWorkbook.Worksheets
            WS.Visible = xlSheetVisible
        End If
    Next WS
End Sub

No need to check for it's name.
I deleted End If and changed the code to the above code as it was showing an error.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,103
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows

ADVERTISEMENT

yes

VBA Code:
Sub UnHideSheets()
    Dim WS As Worksheet
    For Each WS In ThisWorkbook.Worksheets
        WS.Visible = xlSheetVisible
    Next
End Sub
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,103
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
I have to get some sleep, I shall return!
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,103
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Couple of questions for you @RAJESH1960 concerning some of your latest code:

VBA Code:
Dim rngData As Range
Dim strData As String
Dim strTempFile As String
Dim x As Long, y As Long
Dim usr As String
Sheets("ImportData").Activate
y = Sheets("ImportData").Range("A2").CurrentRegion.Columns.Count
x = Sheets("F").Range("B2:B" & Sheets("F").Range("B" & Rows.Count).End(xlUp).Row).Rows.Count
Range("A2").Resize(x, y).Copy
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipBoard
        strData = .GetText
    End With
    usr = Environ("username")
    strTempFile = "C:\Users\" & usr & "\Desktop\Bank.xml"
    With CreateObject("Scripting.FileSystemObject")
        .CreateTextFile(strTempFile, True).Write strData
     End With
     Sheets("Original").Activate
      Range("A2").Select

    ActiveSheet.Shapes.Range(Array("Button 3")).Select
    ActiveSheet.Shapes("Button 3").ZOrder msoSendBackward
    Range("K9").Select
       
Application.ScreenUpdating = True
'
HideSheets
MsgBox ("File saved on Desktop as Bank.XML Copy path and paste in tally.")

1) What does the following do for you:
VBA Code:
    ActiveSheet.Shapes.Range(Array("Button 3")).Select                                                  ' Select the 'Get Data' button
    ActiveSheet.Shapes("Button 3").ZOrder msoSendBackward

I tried testing it, without having your file, and I don't see that it does anything.


2) Try the following code replacement for the full code snippet that I started this post with:
VBA Code:
    Dim x           As Long, y  As Long
    Dim strData     As String
    Dim strTempFile As String
'
    y = Sheets("ImportData").Range("A2").CurrentRegion.Columns.Count
    x = Sheets("F").Range("B2:B" & Sheets("F").Range("B" & Rows.Count).End(xlUp).Row).Rows.Count
'
    Sheets("ImportData").Range("A2").Resize(x, y).Copy
    strData = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")
'
    strTempFile = "C:\Users\" & Environ("username") & "\Desktop\Bank.xml"
    CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True).Write strData
    Application.CutCopyMode = False
'
    Sheets("Original").Activate
    ActiveSheet.Shapes.Range(Array("Button 3")).Select
    ActiveSheet.Shapes("Button 3").ZOrder msoSendBackward
    Range("K9").Select
'
    HideSheets
    Application.ScreenUpdating = True
'
    MsgBox ("File saved on Desktop as Bank.XML Copy path and paste in tally.")

I can't test it to see if it performs any faster because as I already said, I don't have your file, but the coding is definitely shorter.
 

RAJESH1960

Well-known Member
Joined
Mar 26, 2020
Messages
863
Office Version
  1. 2019
Platform
  1. Windows
I have shared the link of the file with you. Please check your conversation box. You will have a better picture what exactly the code does. Here is a sample data for you. Just copy the data and paste it in the original sheet cell A1.
sample data.xlsx
ABCDEFGHI
1Rajesh Shah
2Bangalore
3ICICI Book
4
5
61-Aug-2021 to 31-Oct-2021
7DateParticularsVch TypeVch No.DebitCredit
801-08-2021DrOpening Balance2013240.33
902-08-2021Cr(as per details)Receipt134816380.00
10January4823.00 Cr
11February11720.00 Cr
12March163.00 Dr
1302-08-2021CrAprilReceipt10011764.00
1403-08-2021Cr(as per details)Receipt13492000.00
15January1000.00 Cr
16January1000.00 Cr
1703-08-2021Cr(as per details)Receipt13502770.00
18January2800.00 Cr
19February30.00 Dr
2003-08-2021CrMarchReceipt100210000.00
2103-08-2021DrAprilPayment100346504.00
2203-08-2021DrMayPayment100440000.00
2303-08-2021DrJunePayment100510000.00
2403-08-2021DrJulyPayment100682071.00
2503-08-2021DrAugustPayment100735000.00
2603-08-2021DrSeptemberPayment100838220.00
2703-08-2021DrOctoberPayment100915000.00
2803-08-2021CrNovemberReceipt1010498000.00
2903-08-2021CrDecemberReceipt101212850.00
3003-08-2021CrJanuaryContra102749000.00
3104-08-2021Dr(as per details)Payment13511062.00
32Sunday944.00 Dr
33Monday118.00 Dr
3404-08-2021Cr(as per details)Receipt13521704.00
35Monday984.00 Cr
36Tuesday720.00 Cr
3704-08-2021Dr(as per details)Payment135394572.00
38Monday94612.00 Dr
39Tuesday40.00 Cr
4004-08-2021DrWednesdayContra1013190000.00
4104-08-2021DrThursdayPayment10147000.00
4204-08-2021DrFridayPayment101550000.00
4304-08-2021DrSaturdayContra101620000.00
4404-08-2021DrSundayPayment101743242.00
4504-08-2021DrMondayPayment101830000.00
4604-08-2021CrTuesdayReceipt101910175.00
4704-08-2021CrWednesdayReceipt1020500000.00
4804-08-2021DrThursdayPayment102111246.00
4904-08-2021CrFridayReceipt10222442.00
5004-08-2021DrSaturdayPayment1024190000.00
5104-08-2021DrSundayContra1023200.00
5231-10-2021DrMondayPayment1132146822.00
538091011.002822390.97
54CrClosing Balance2013289.97
552822390.972822390.97
Sheet2
 
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,152,263
Messages
5,769,117
Members
425,518
Latest member
seothaeng

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