Home > Enterprise >  Need help to data for Invoice data entry
Need help to data for Invoice data entry

Time:10-12

Adding to the current VBA code, is there a way to display a maximum of 4 data in a row and the others will fall to the next row as shown in the picture (right side)?

enter image description here

Option Explicit

Sub InvoiceDataGrouping()
    Dim DataSet As Variant, Counter As Long, Dict As Object
  
    'Set Dict = New Scripting.Dictionary 'Early Binding
    Set Dict = CreateObject("Scripting.Dictionary") 'Late Binding
    
    'stores in an array all the data from columns A and B,
    'starting at A1 and up to the last row with data from column B.
    DataSet = Sheets("DO").Range("A1", Range("B" & Rows.Count).End(3)).Value2
  
    For Counter = 1 To UBound(DataSet)
        
        Dict(DataSet(Counter, 1)) = Dict(DataSet(Counter, 1)) _
                                      " " & DataSet(Counter, 2)
    Next
  
    Sheets("DO").Range("E1").Resize(Dict.Count, 2).Value = Application.Transpose(Array(Dict.keys, Dict.items))
    
    Set Dict = Nothing
End Sub

CodePudding user response:

Use a Collection rather than a string to hold the invoice numbers. Then loop through the collection creating a string with a maximum of 4 invoices.

Sub InvoiceDataGroupingBy4()

    Dim DataSet As Variant, dict As Object, key
    Dim lastrow As Long, i As Long, r As Long, n As Long
    Dim s As String
  
    'Set Dict = New Scripting.Dictionary 'Early Binding
    Set dict = CreateObject("Scripting.Dictionary") 'Late Binding
    
    'stores in an array all the data from columns B and C,
    'starting at B1 and up to the last row with data from column C.
    With Sheets("DO")
        lastrow = .Range("C" & Rows.count).End(xlUp).Row
        DataSet = .Range("B1:C" & lastrow)
    End With
    
    For i = 1 To UBound(DataSet)
        key = DataSet(i, 1) ' date
        If Not dict.exists(key) Then
             dict.Add key, New Collection
        End If
        dict(key).Add DataSet(i, 2) ' invoice no
    Next
   
    ' reuse DataSet for grouping
    For Each key In dict
        n = dict(key).count ' number of invoices for date
        For i = 1 To n
            s = s & " " & dict(key)(i)
            If (i Mod 4 = 0) Or (i = n) Then
                 r = r   1
                 DataSet(r, 1) = key
                 DataSet(r, 2) = Trim(s) ' remove leading space
                 s = ""
            End If
        Next
    Next

    ' write re-used part of DataSet to sheet
    Sheets("DO").Range("E1").Resize(r, 2) = DataSet
    Set dict = Nothing
End Sub

CodePudding user response:

Here is a rather messy function:

Function group_array(data As Variant) As Variant
    Dim i As Long, count As Byte, ref As String, group As String, id As Long
    
    ' store the first date and set the first group id
    ref = data(1, 1)
    id = 1
    
    ' change the first date to make it unique
    data(1, 1) = data(1, 1) & ":1"
    
    ' make a counter to limit the items to four in a group
    count = 0
    
    ' go through the data array, changing it to build the groups
    For i = 2 To UBound(data)
        count = count   1  ' increment group count
        If ref = data(i, 1) And count < 4 Then
            ref = data(i, 1)
            data(i, 1) = data(i, 1) & ":" & CStr(id)
        Else ' a new group starts here
            id = id   1
            count = 0
            ref = data(i, 1)
            data(i, 1) = data(i, 1) & ":" & CStr(id)
        End If
    Next
    group_array = data
End Function

You can call it with a line in your original code like this:

    ' group the data using the function below
    DataSet = group_array(DataSet)
  • Related