VBA to change horizontal range to vertical with conditions

[RAJESH1960]

Hello experts

I need your expertise to help me write a code to arrange the data from horizontal data to vertical with some conditions. Sheet1 contains the horizontal data. In sheet1 cell G1 contains the name of the bank. The expected result is in the sheet2. The Cr Amt and Dr Amt are posted depending on the column “Type”. The amounts in sheet2 column Cr. Amt should be posted always positive and column Dr. Amt negative.
If, in sheet1, the Type is Receipt, then Name should be posted to Credit in sheet2 & amount must be posted positive and Bank Name should be in Debit column and amount should be negative.
If, in sheet1, the Type is Payment, then Name should be posted to Debit in sheet2 & amount must be posted positive and Bank Name should be in Credit column and amount should be negative.
Please note that the original data contains rows from 300 to 4000.

Query code 28.12.21.xlsx
	A	B	C	D	E	F	G	H	I
1	Date	Type	No.	xxxx	Name	Debit	Credit		ICICI Bank
2	28-12-2021	Receipt	1		April	500.00
3	28-12-2021	Payment	2		October		1000.00
4	28-12-2021	Contra	3		Cash	1500.00
5	28-12-2021	Contra	4		Cash		2000.00
6
Raw

Query code 28.12.21.xlsx
	A	B	C	D	E	F	G	H
1	Date	Type	No.	xxxx	Credit	Cr Amt	Debit	Dr Amt
2	28-12-2021	Receipt	1		April	500	ICICI	-500
3	28-12-2021	Payment	2		ICICI	1000	October	-1000
4	28-12-2021	Contra	3		Cash	1500	ICICI	-1500
5	28-12-2021	Contra	4		ICICI	2000	Cash	-2000
Result

 

[DanteAmor]

Try this:

Sub change_horizontal_to_vertical()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
  Dim bnk As String
  
  With Sheets("Raw")
    bnk = .Range("I1").Value
    a = .Range("A2:G" & .Range("A" & Rows.Count).End(3).Row).Value
  End With
  
  ReDim b(1 To UBound(a, 1), 1 To 9)
  For i = 1 To UBound(a, 1)
    For j = 1 To 4
      b(i, j) = a(i, j)
    Next
    If a(i, 6) = "" Then
      b(i, 5) = bnk
      b(i, 6) = a(i, 7)
      b(i, 7) = a(i, 5)
      b(i, 8) = a(i, 7) * -1
    Else
      b(i, 5) = a(i, 5)
      b(i, 6) = a(i, 6)
      b(i, 7) = bnk
      b(i, 8) = a(i, 6) * -1
    End If
  Next
  Sheets("Result").Range("A2").Resize(UBound(b, 1), 8).Value = b
End Sub

 

[RAJESH1960]

Try this:

Sub change_horizontal_to_vertical()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
  Dim bnk As String
 
  With Sheets("Raw")
    bnk = .Range("I1").Value
    a = .Range("A2:G" & .Range("A" & Rows.Count).End(3).Row).Value
  End With
 
  ReDim b(1 To UBound(a, 1), 1 To 9)
  For i = 1 To UBound(a, 1)
    For j = 1 To 4
      b(i, j) = a(i, j)
    Next
    If a(i, 6) = "" Then
      b(i, 5) = bnk
      b(i, 6) = a(i, 7)
      b(i, 7) = a(i, 5)
      b(i, 8) = a(i, 7) * -1
    Else
      b(i, 5) = a(i, 5)
      b(i, 6) = a(i, 6)
      b(i, 7) = bnk
      b(i, 8) = a(i, 6) * -1
    End If
  Next
  Sheets("Result").Range("A2").Resize(UBound(b, 1), 8).Value = b
End Sub

That was really fast DanteAmor. It's PERFECT. Thank you very much.

 

[DanteAmor]

Im glad to help you, thanks for the feedback.