• 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

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.)

82547

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

Attachments

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 1Dim 2Dim 3Dim 4Dim 5
 

Attachments

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 …​
 

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.
 

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

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.

82601
 

Attachments

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

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.
 

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
 

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 !​
 

Gunasekaran

Member
Any online training is provides by you? or your team , I am looking good & valuable training,
 
Last edited by a moderator:
Top