Extract rows into a limited template based on multiple criteria

1

I have an issue in extracting from "Datadump" into several continuous "Template" (as the template can only contain 10 rows of item).

Here are my intentions:

  1. From the data dump (sample above), is it possible to automatically extract the appropriate value into the Template with a maximum of 10 rows for each set of Template. And then colour-code those that have been printed to the Template. Template These are the Template (Payment Voucher) limitations:

    a. Each template contains the data from only 1 (one) day

If in 1st January 2020 & 2nd January 2020, there are 5 transactions /day, there would have to be 2 Templates (1 for each day).

b. Each Template should only be from 1 Source

So if in 1st January 2020 & 2nd January 2020, there are 5 transactions/day from each Source A & B, there would be 4 Templates (1 for each source/day).

c. Each template could only contain 10 lines.

So if in 1st January 2020 & 2nd January 2020, there are 11 transactions/day from each Source A & B, there would be 8 Templates (2 for each source/day).

I have also attached a Before and After for reference :)

Before:

Before

Template

After:

After

Voucher Page 1

Voucher Page 2

Since I am new to VBA, I would have no issue with the inputs to their appropriate places and to colour code. But I am still learning about the loop function that I believe would be required for this?

Any help would be much appreciated!

@Edit:

Values for the templates are:

1. Credit Source = Source + Source Name
2. Total = All values inside the voucher
3. Account = Item Code
4. Detail = Item Name
5. Unit Code = Unit Code
6. Value = Total Debit

Here are the codes that I could come up with for now (Trying to break the process down)

@edit @edit

Sub learn()
Set wb = ThisWorkbook

Set dtws = Worksheets("Database")
Set wstr = Worksheets("trial")
Dim vcdate
vcdate = wstr.Cells(2, "B").Value
Dim vcsource
vcsource = wstr.Cells(2, "D").Value

Dim NoE As Long
Dim lmtcount As Long

'Limiting No. Of Entries

'With wstr
 '   .Cells(2, 1).Value = Application.WorksheetFunction.CountIfs(dtws.Range("A:A"), vcdate, dtws.Range("J:J"), vcsource)

 '   NoE = wstr.Cells(2, 1).Value

'If NoE < 11 Then
'    .Cells(2, 3).Value = NoE
'Else
'    .Cells(2, 3).Value = 10

'End If
'End With

'lmtcount = wstr.Cells(2, 3).Value

'MsgBox NoE
'End of Limiting No. Of Entries


'------------------------
'Inputting Appropriately
'------------------------

Set tempws = Worksheets("Template")

Dim lrow As Long
Dim Count1 As Long

For Count1 = 1 To 100
    lrow = tempws.Range("A" & Rows.Count).End(xlUp).Row
    'MsgBox lrow
    If lrow = 19 Then Exit For
    '-----------------------------------------
    'MsgBox dtws.Cells(Count1 + 1, "A").Value
    '-----------------------------------------
    'Cross-Check if the same date
    If CDate(dtws.Cells(Count1 + 1, "A").Value) > CDate(vcdate) Then Exit For
    '-----------------------------------------
    'Cross check error
    'MsgBox dtws.Cells(Count1 + 1, "A").Value
    'MsgBox dtws.Cells(Count1 + 1, "J").Value
    '-----------------------------------------
    If dtws.Cells(Count1 + 1, "J").Value2 = vcsource Then
        With tempws
            .Cells(lrow + 1, "A") = dtws.Cells(Count1 + 1, 2)
            .Cells(lrow + 1, "C") = dtws.Cells(Count1 + 1, 3) & " - " & dtws.Cells(Count1 + 1, 5)
            .Cells(lrow + 1, "G") = dtws.Cells(Count1 + 1, 6)
            .Cells(lrow + 1, "I") = dtws.Cells(Count1 + 1, 9)
        End With
       '-----------------------------------------
       'Colour Code
       '-----------------------------------------
       With dtws
            .Cells(Count1 + 1, 2).Interior.Color = 13998939
            .Cells(Count1 + 1, 3).Interior.Color = 13998939
            .Cells(Count1 + 1, 6).Interior.Color = 13998939
            .Cells(Count1 + 1, 9).Interior.Color = 13998939
        End With


    End If


Next Count1


With tempws
        .Cells(20, "I").Formula = "=sum(I10:I19)"
        .Cells(7, "C").Value = tempws.Cells(20, "I").Value
        .Cells(4, "J").Value = vcdate
        .Cells(6, "C").Value = vcsource

End With

'----------------------------------------
'Input Tracking Order
'----------------------------------------
lrowtr = wstr.Range("A" & Rows.Count).End(xlUp).Row
With wstr
    .Cells(lrowtr + 1, "A").Value = vcsource
    .Cells(lrowtr + 1, "B").Value = vcdate
    .Cells(lrowtr + 1, "C").Value = Count1
End With
'----------------------------------------
'End of Input Tracking order
'----------------------------------------

End Sub

I believe I would not have an issue with the colour coding but it seems that the data extraction is the main issue...

Any help would be appreciated!

albert

Posted 2020-01-09T03:40:38.503

Reputation: 11

No answers