# Data from Vertical Order from Horizontal Order for Each Ledger account with the Conditions

#### Gunasekaran

##### Member
Hi All,

I have baseline VBA knowledge, but not enough to do loop condition:

I have an excel spreadsheet with Employee Project Allocation information. I need to prepare the "Journal Entry" for that employee based on the Project Allocation Amount.

Each Ledger account's Project Amount will be transposed (Vertical Order from Horizontal Order) for both DR and CR Ledger accounts. For 1 & 2 Series ledgers, keep only one line item with entry amount (no need to allocate factors for 1 & 2 Series).

The Transpose work will take more than 6 hours (I have more than 60 employees like that - I have only provided the information of one employee)

I would greatly appreciate any help from those more experienced with loops and iterating through worksheets.

#### Attachments

• 15 KB Views: 5

#### Marc L

##### Excel Ninja
Hi, according to your attachment an Excel basics VBA demonstration as a beginner starter :​
Code:
``````Sub Demo1()
Dim L&, R&, Z%, N%
L = 2
Sheet2.UsedRange.Offset(1).Clear
With Application
.ScreenUpdating = False
With Sheet1.UsedRange.Rows
For R = 3 To .Count
Z = .Cells(R, 5) = 0
N = IIf(.Cells(R, 5 + Z) < "3", 1, 10)
.Cells(R, 5 + Z).Copy Sheet2.Cells(L, 1).Resize(N)
If N = 1 Then .Cells(R, 2).Copy Sheet2.Cells(L, 8) _
Else .Rows(R).Columns("F:O").Copy: Sheet2.Cells(L, 8).PasteSpecial 12, , , True
Sheet2.Cells(L, 9).Resize(N) = Array("Dr", "Cr")(1 + Z)
L = L + N
Next
End With
.Goto Sheet2.[A1], True
.ScreenUpdating = True
End With
End Sub``````
Do you like it ? So thanks to click on bottom right Like !​

#### Gunasekaran

##### Member
Hello Marc, this is one of the most popular VBA forums on Google. You are the very best, too. Yes, I tested your code, but a few Ledger Account lines were missing. If there are two ledger accounts in the same row, I thought they had been skipped. (This Red color Ledger account details.)

Also, How to bring DR & CR value with validation formula in JV Sheet.

#### Attachments

• 26.3 KB Views: 6
Last edited:

#### Marc L

##### Excel Ninja
According to your previous post attachment my starter Excel basics VBA demonstration revamped :​
Code:
``````Sub Demo1r()
Dim L&, R&, C%, N%, S@(4 To 5, 0)
L = 2
Sheet2.[A1].CurrentRegion.Offset(1).Clear
With Application
.ScreenUpdating = False
With Sheet1.UsedRange.Rows
For R = 3 To .Count
For C = 4 To 5
If .Cells(R, C) Then
N = IIf(.Cells(R, C) < "3", 1, 10)
.Cells(R, C).Copy Sheet2.Cells(L, 1).Resize(N)
If N = 1 Then .Cells(R, 2).Copy Sheet2.Cells(L, 8) _
Else .Rows(R).Columns("F:O").Copy: Sheet2.Cells(L, 8).PasteSpecial 12, , , True
Sheet2.Cells(L, 9).Resize(N) = Array("Dr", "Cr")(C - 4)
S(C, 0) = S(C, 0) + .Cells(R, 2)
L = L + N
End If
Next C, R
End With
Sheet2.[M2:M3] = S
.Goto Sheet2.[A1], True
.ScreenUpdating = True
End With
End Sub``````
Do you like it ? So thanks to click on bottom right Like !

#### Gunasekaran

##### Member
Hey Macr, thanks for your amazing support. I forgot to mention one more data capture in the first post. Please accept my sincere apologies.

I will update DIM details from Master Data in the same JV Entry Post as Vertical to Horizontal Orders. All Ledger accounts except "1" and "2".

 Dim 1 Dim 2 Dim 3 Dim 4 Dim 5

#### Attachments

• 28.4 KB Views: 5

#### Marc L

##### Excel Ninja
To simplify the procedure it should be smarter to include Dim3 in the Master_Data worksheet​
or obviously use only exactly matching headers …​

#### Attachments

• 28.4 KB Views: 5

#### Marc L

##### Excel Ninja
Are you sure that's all ? As a starter you should mod yourself what you misexplained / forgot.​
It will be my last try ...​

#### Gunasekaran

##### Member
Yes that's all also while working time in sheet1 I have more than #N/A text character lines in D column. Which is fast way to delete those lines.

#### Marc L

##### Excel Ninja
You can sort the data range and delete at once the #N/A block of rows …​

#### Gunasekaran

##### Member
Ok, sure I will do it,

kindly help me that post 5. To update Dim details. This is my last question here, and I am moving final stage. Appreciate your support..

Last edited:

#### Marc L

##### Excel Ninja
According to post #3 attachment with matching 'Dim' headers like in post #7 my last revised demonstration :​
Code:
``````Sub Demo1r2d2()
Dim L&, Rd As Range, V, R&, C%, N%, K%, S@(4 To 5, 0)
L = 2
With Sheet3.UsedRange.Rows:  Set Rd = .Item("2:" & .Count).Columns:  End With
Sheet2.[A1].CurrentRegion.Offset(1).Clear
With Application
V = .Match(Sheet2.[A1:F1], Rd.Rows(0), 0)
.ScreenUpdating = False
With Sheet1.UsedRange.Rows
For R = 3 To .Count
For C = 4 To 5
If .Cells(R, C) Then
N = IIf(.Cells(R, C) < "3", 1, 10)
.Cells(R, C).Copy Sheet2.Cells(L, 1).Resize(N)
If N = 1 Then
.Cells(R, 2).Copy Sheet2.Cells(L, 8)
Else
.Rows(R).Columns("F:O").Copy
Sheet2.Cells(L, 8).PasteSpecial 12, , , True
For K = 2 To 6
If IsNumeric(V(K)) Then Rd(V(K)).Copy Sheet2.Cells(L, K)
Next
End If
Sheet2.Cells(L, 9).Resize(N) = Array("Dr", "Cr")(C - 4)
S(C, 0) = S(C, 0) + .Cells(R, 2)
L = L + N
End If
Next C, R
End With
Sheet2.[M2:M3] = S
.CutCopyMode = False
.Goto Sheet2.[A1], True
.ScreenUpdating = True
End With
Set Rd = Nothing
End Sub``````
Do you appreciate the support ? So thanks to click on bottom right Like !

#### p45cal

##### Well-Known Member
I'm not sure I've got this right.
Can you tell me if the data on sheet JV of the attached is correct?
Note that it's not in any particular order and I added a blank Dim3 column to the Master_Data - Dim sheet.

If it's correct I'll refine it to work better.

#### Attachments

• 37.1 KB Views: 1

#### Gunasekaran

##### Member
@p45cal - yes, you are right, I did share this attachment data for one employee JV entry, but I have over 50 employee data running by loop.

Loop condition was done..

How to capture this DIM 3 information from working sheet "B2" for each set entry? However, I cannot share this confidential file data.

I would like to update this Dim 3 From D2 to last row, again next run time, will update above last row data +1 to till last. Please let me know if my question is unclear. Please refer to the attachment. Sorry for the inconvenience.

#### Attachments

• 49 KB Views: 3

#### Marc L

##### Excel Ninja
I added a blank Dim3 column to the Master_Data - Dim sheet.​
To simplify the procedure it should be smarter to include Dim3 in the Master_Data worksheet​
… and faster than the way chosen in post #7.​

#### p45cal

##### Well-Known Member
@Gunasekaran
yes, you are right, I did share this attachment data for one employee JV entry, but I have over 50 employee data running by loop.
Now you're confusing me.
I was asking whether the data on the JV sheet, which is the result of a Power Query query doing its thing, was correct as a transformation of the data on the other 2 sheets. I attach it again, this time with some dummy data in the D3 column of the Master_Data - Dim sheet.
If you want to see it in action, update the data in the other two sheets, making sure that the data remains completely within its table (the table will change its size), and don't change the headers, then go back to the JV sheet, right-click any cell within the table there, and choose Refresh.

If the transformation is good, or it needs a little tweaking, I should be able to refine it to make it more flexible.

@Marc L ,
… and faster than the way chosen in post #7.
I've no idea. A lot faster than 6 hours though, perhaps a second or two, and that'll probably be the same for the OP's larger data set as Power Query is designed to handle big data.

#### Attachments

• 38 KB Views: 2

#### Marc L

##### Excel Ninja
Faster on VBA side at least 'cause with the smart way that just needs a direct unique copy rather than matching and copying column by column …​

#### Gunasekaran

##### Member
@p45cal Yes, this is much better than a macro, but there are still a few more stages to complete. I need to pull the data from one of the payroll summary sheets into the Working Data page, then perform some transposition, deletion, and formula activities. I completed those stages in macro, but I'm not sure how to describe my process step in this context. Due to poor communication on my part, if it is okay with you, I will set up a brief Zoom meeting to explain the project. However, this method requires incredibly little effort. I am sure.

@Marc L My best friend is the last to mention his help. Once more, I would want to thank Marc L. Here, I'd want to express my concern on how to take your Macro class. If that's okay, I'm willing to pay to learn the material for however long it takes. I'd love to hear your ideas.

#### Gunasekaran

##### Member
… and faster than the way chosen in post #7.​
This Dim 3 this each Employee ID, so Not like that Dim1 to Dim5...

#### Marc L

##### Excel Ninja
If the Dim columns positions do not change aka always Dim #1 -2 - 4 - 5 in columns B:E of Master Data worksheet​
so my post #12 can be simplified 'cause that no needs to loop & match any header but just two Copy codelines …​

#### Gunasekaran

##### Member
Yes,
If the Dim columns positions do not change aka always Dim #1 -2 - 4 - 5 in columns B:E of Master Data worksheet​
so my post #12 can be simplified 'cause that no needs to loop & match any header but just two Copy codelines …​
that is working perfectly, Thanks a lot Marc L. Dim 3 details from starting row to till last row to update by every Loop condition time. ..so Here. Dim 3 not Standard for Each employee

#### Gunasekaran

##### Member
How to learn Macro code here...kindly advise

#### Marc L

##### Excel Ninja
So according to your post #3 attachment as it is with its static Master Data worksheet​
my demonstration last revision including the updated B2 cell Cost Center as Dim 3 :​
Code:
``````Sub Demo1bb8()
Dim L&, T\$(4 To 5), Rd As Range, R&, C%, N%, S@(4 To 5, 0)
L = 2:  T(4) = "Dr":  T(5) = "Cr"
With Sheet3.UsedRange.Rows:  Set Rd = .Item("2:" & .Count).Columns:  End With
Sheet2.[A1].CurrentRegion.Offset(1).Clear
With Application
.ScreenUpdating = False
With Sheet1.UsedRange.Rows
For R = 3 To .Count
For C = 4 To 5
If .Cells(R, C) Then
N = IIf(.Cells(R, C) < "3", 1, 10)
.Cells(R, C).Copy Sheet2.Cells(L, 1).Resize(N)
.Range("B2").Copy Sheet2.Cells(L, 4).Resize(N)
If N = 1 Then
.Cells(R, 2).Copy Sheet2.Cells(L, 8)
Else
Rd("B:C").Copy Sheet2.Cells(L, 2)
Rd("D:E").Copy Sheet2.Cells(L, 5)
.Rows(R).Columns("F:O").Copy
Sheet2.Cells(L, 8).PasteSpecial 12, , , True
End If
Sheet2.Cells(L, 9).Resize(N) = T(C)
S(C, 0) = S(C, 0) + .Cells(R, 2)
L = L + N
End If
Next C, R
End With
Sheet2.[M2:M3] = S
.CutCopyMode = False
.Goto Sheet2.[A1], True
.ScreenUpdating = True
End With
Set Rd = Nothing
End Sub``````
You should Like it !​

#### Marc L

##### Excel Ninja
How to learn Macro code here...kindly advise
Using the Macro Recorder, reading the VBA help & training …​
From Excel forums solutions, when you do not understand a statement, read its VBA help …​

#### Gunasekaran

##### Member
Any online training is provides by you? or your team , I am looking good & valuable training,

Last edited by a moderator: