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]

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:

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

If WS.Name <> "Original" Then
end if

Hide sheets should be as it is. Right?

 

[RAJESH1960]

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]

yes

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

 

[RAJESH1960]

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:

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]

yes

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

 

[johnnyL]

I have to get some sleep, I shall return!

 

[RAJESH1960]

I have to get some sleep, I shall return!

Ok. Good Night. I have to go to work too.

 

[johnnyL]

Couple of questions for you @RAJESH1960 concerning some of your latest 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:

    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:

    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]

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
	A	B	C	D	E	F	G	H	I
1	Rajesh Shah
2	Bangalore
3	ICICI Book
4
5
6	1-Aug-2021 to 31-Oct-2021
7	Date	Particulars				Vch Type	Vch No.	Debit	Credit
8	01-08-2021	Dr	Opening Balance						2013240.33
9	02-08-2021	Cr	(as per details)			Receipt	1348	16380.00
10			January						4823.00 Cr
11			February						11720.00 Cr
12			March					163.00 Dr
13	02-08-2021	Cr	April			Receipt	1001	1764.00
14	03-08-2021	Cr	(as per details)			Receipt	1349	2000.00
15			January						1000.00 Cr
16			January						1000.00 Cr
17	03-08-2021	Cr	(as per details)			Receipt	1350	2770.00
18			January						2800.00 Cr
19			February					30.00 Dr
20	03-08-2021	Cr	March			Receipt	1002	10000.00
21	03-08-2021	Dr	April			Payment	1003		46504.00
22	03-08-2021	Dr	May			Payment	1004		40000.00
23	03-08-2021	Dr	June			Payment	1005		10000.00
24	03-08-2021	Dr	July			Payment	1006		82071.00
25	03-08-2021	Dr	August			Payment	1007		35000.00
26	03-08-2021	Dr	September			Payment	1008		38220.00
27	03-08-2021	Dr	October			Payment	1009		15000.00
28	03-08-2021	Cr	November			Receipt	1010	498000.00
29	03-08-2021	Cr	December			Receipt	1012	12850.00
30	03-08-2021	Cr	January			Contra	1027	49000.00
31	04-08-2021	Dr	(as per details)			Payment	1351		1062.00
32			Sunday					944.00 Dr
33			Monday					118.00 Dr
34	04-08-2021	Cr	(as per details)			Receipt	1352	1704.00
35			Monday						984.00 Cr
36			Tuesday						720.00 Cr
37	04-08-2021	Dr	(as per details)			Payment	1353		94572.00
38			Monday					94612.00 Dr
39			Tuesday						40.00 Cr
40	04-08-2021	Dr	Wednesday			Contra	1013		190000.00
41	04-08-2021	Dr	Thursday			Payment	1014		7000.00
42	04-08-2021	Dr	Friday			Payment	1015		50000.00
43	04-08-2021	Dr	Saturday			Contra	1016		20000.00
44	04-08-2021	Dr	Sunday			Payment	1017		43242.00
45	04-08-2021	Dr	Monday			Payment	1018		30000.00
46	04-08-2021	Cr	Tuesday			Receipt	1019	10175.00
47	04-08-2021	Cr	Wednesday			Receipt	1020	500000.00
48	04-08-2021	Dr	Thursday			Payment	1021		11246.00
49	04-08-2021	Cr	Friday			Receipt	1022	2442.00
50	04-08-2021	Dr	Saturday			Payment	1024		190000.00
51	04-08-2021	Dr	Sunday			Contra	1023		200.00
52	31-10-2021	Dr	Monday			Payment	1132		146822.00
53			8091011.00						2822390.97
54		Cr	Closing Balance			2013289.97
55			2822390.97						2822390.97
Sheet2