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:
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. 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:
After:
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!