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