VBA to convert accounting entries into a desired format

[baleshst]

I have a excel sheet in which the debit credit entries are done between entities. Which is the source sheet which looks somewhat like this.

Copy of Mitesh(1).xlsx
	A	B	C	D	E	F	G	H	I	J	K
1						INCOME				EXPENSES
2	S.No.	Name From	Name to	INCOME GL code	Consol Grouping Income	Income under the Head	Income during the year Dr	EXPENSES GL code	Consol Grouping Exps	Expenses under the Head	Expenses during the year Cr
3	1	Phoenix Mills	Spaces Private Limited	320201-003	From Financial Assests carried at fair value through profit and loss	Interest	214
4	1	Spaces Private Limited	Phoenix Mills					500002-004	Interest Expenses	Interest	214
5	2	Phoenix Mills	Hospitality Services Limited	320100-024	License fees and Rental Income	Rent, Compensation & Other recoveries	1,28,48,070	420111-217	Advertisement, Promotion and Marketing Expenses	Service charges	1,08,402
6	2	Hospitality Services Limited	Phoenix Mills	320100-003	Others	Operating Income	1,08,402	450002-003	Rent	Rent	1,28,48,070
Input

I would like the output to be like this. Request you to please give me a code to work this out. Thanks in advance.

Copy of Mitesh(1).xlsx
	A	B	C	D	E	F	G	H
1
2	S.No.	Name From	Name to	GL code	Debit/Credit	INCOME	EXPENSES
3	1	Phoenix Mills	Spaces Private Limited	320201-003	Debit	214
4	1	Spaces Private Limited	Phoenix Mills	500002-004	Credit		214
5	2	Phoenix Mills	Hospitality Services Limited	320100-024	Debit	12848070
6	2	Hospitality Services Limited	Phoenix Mills	450002-003	Credit		12848070
7	3	Hospitality Services Limited	Phoenix Mills	320100-003	Debit	108402
8	3	Phoenix Mills	Hospitality Services Limited	420111-217	Credit		108402
9
Output

 

[DanteAmor]

According to your examples, records always come in pairs (debit and credit), so try the following, put all the code in a module and run the "Convert_Accounting_Entries" macro.

Dim a As Variant, b As Variant        'At the beginning of all the code

Sub Convert_Accounting_Entries()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim i As Long, k As Long, n As Long
  
  With Sheets("Input")
    a = .Range("A3:K" & .Range("A" & Rows.Count).End(3).Row).Value
    ReDim b(1 To UBound(a, 1) * 2, 1 To 7)
  End With
    
  For i = 1 To UBound(a, 1) Step 2
    n = n + 1
    k = k + 1
    If a(i, 4) = "" Or a(i + 1, 4) = "" Then
      If a(i, 4) <> "" Then Call Proc1(a, b, i, k, n) Else Call Proc2(a, b, i, k, n)
    Else
      Call Proc1(a, b, i, k, n)
      n = n + 1
      k = k + 1
      Call Proc2(a, b, i, k, n)
    End If
  Next
  
  With Sheets("Output")
    .Range("A3:G" & Rows.Count).ClearContents
    .Range("A3").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
  
End Sub

Sub Proc1(a, b, i, k, n)
  b(k, 1) = n
  b(k, 2) = a(i, 2)
  b(k, 3) = a(i, 3)
  b(k, 4) = a(i, 4)
  b(k, 5) = "Debit"
  b(k, 6) = a(i, 7)
  
  k = k + 1
  b(k, 1) = n
  b(k, 2) = a(i + 1, 2)
  b(k, 3) = a(i + 1, 3)
  b(k, 4) = a(i + 1, 8)
  b(k, 5) = "Credit"
  b(k, 7) = a(i + 1, 11)
End Sub

Sub Proc2(a, b, i, k, n)
  b(k, 1) = n
  b(k, 2) = a(i + 1, 2)
  b(k, 3) = a(i + 1, 3)
  b(k, 4) = a(i + 1, 4)
  b(k, 5) = "Debit"
  b(k, 6) = a(i + 1, 7)

  k = k + 1
  b(k, 1) = n
  b(k, 2) = a(i, 2)
  b(k, 3) = a(i, 3)
  b(k, 4) = a(i, 8)
  b(k, 5) = "Credit"
  b(k, 7) = a(i, 11)
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --