• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

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

  • Community_JV.xlsx
    15 KB · Views: 5
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 !​
 
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.)

82547

Also, How to bring DR & CR value with validation formula in JV Sheet.
82548
I would appreciate your advice.
 

Attachments

  • Community_JV.xlsm
    26.3 KB · Views: 6
Last edited:
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 !
 
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 1Dim 2Dim 3Dim 4Dim 5
 

Attachments

  • Community_JV.xlsm
    28.4 KB · Views: 5
To simplify the procedure it should be smarter to include Dim3 in the Master_Data worksheet​
or obviously use only exactly matching headers …​
 
Ok, Now i changed Header as per your request or You can change as per your wise, I will do follow as per your advice.
 

Attachments

  • Community_JV.xlsm
    28.4 KB · Views: 5
Are you sure that's all ? As a starter you should mod yourself what you misexplained / forgot.​
It will be my last try ...​
 
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.
 
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:
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 !
 
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

  • Chandoo50776Community_JV01.xlsx
    37.1 KB · Views: 1
@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.

82601
 

Attachments

  • Chandoo50776Community_JV01.xlsx
    49 KB · Views: 3
@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

  • Chandoo50776Community_JV01bb.xlsx
    38 KB · Views: 3
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 …​
 
@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.
 
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 …​
 
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
 
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 !​
 
Any online training is provides by you? or your team , I am looking good & valuable training,
 
Last edited by a moderator:
Back
Top