Return all billing codes billed per customer visit

[JamesonMH]

Hi folks,

I need a formula column to aggregate the codes billed per customer visit (solution would look like E2:E10 below). Then later I can include the results in a PivotTable to see the combo frequency of codes billed at this store.

There is a large list of customer transactions. Each row includes a specific 4 character billing code that the customer was charged. Some customers may have many rows for a single visit (e.g. 6 or 7 distinct billing codes). Other customers may have just 1 row.

I've tried variations with FREQUENCY, SIGN and nested IF's with no luck. I'm sure there's a VBA solution using a For each loop, but I'm not there yet to figure out.

I've already prepped the data; it's filtered by customer name and a helper column is included to mark a "1" when it's a distinct customer visit (i.e. subsequent rows immediately below would be blank if it's the same customer/same day).

	A	B	C	D	E
1	Customer	Date	Distinct customer visit? (yes = 1)	Code billed	Codes billed per customer visit
2	ABC	Sep 01	1	499J	499J, 550M
3	ABC	Sep 01		550M
4	DEF	Sep 02	1	425H	425H
5	DEF	Sep 05	1	690B	690B, 701T, 499J, 880Q
6	DEF	Sep 05		701T
7	DEF	Sep 05		499J
8	DEF	Sep 05		880Q
9	GHH	Sep 08	1	701T	701T, 499J
10	GHH	Sep 08		499J

<tbody>
</tbody>

Many thanks for reading through and your time!

James

 

[JamesonMH]

Well, simple VBA can do this. For example, open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM. Paste the following code into the window that opened:

Public Function GetCodes(ByVal MyData As Range) As String
Dim MyStuff As Variant, i As Long, j As Long, c As Long, ary(1 To 20), w As Variant


    MyStuff = MyData.Value
    If MyStuff(1, 3) <> 1 Then Exit Function
    MyStuff(1, 3) = 0
    For i = 1 To UBound(MyStuff)
        If MyStuff(i, 3) = 1 Then Exit For
        If MyStuff(i, 4) = "" Then Exit For
        c = c + 1
        ary(i) = MyStuff(i, 4)
    Next i
    For i = 1 To c
        For j = 1 To c - i
            If ary(j) > ary(j + 1) Then
                w = ary(j)
                ary(j) = ary(j + 1)
                ary(j + 1) = w
            End If
        Next j
    Next i
            
    For i = 1 To c
        GetCodes = GetCodes & ary(i) & IIf(i < c, ",", "")
    Next i
        
End Function

Press Alt-Q. Now put this formula in E2:

=GetCodes(A2:D10)

Copy down the column as needed. I have no idea about performance though. With 77K lines, running a mini-sort on each line could take a bit. If you try it, I'd be curious to see how long it takes. There are ways to improve on this, depending on whether you have some .NET components installed on your PC.

However, it might be possible in the near future to do this with native formulas again. About a year ago, Microsoft announced some new functions, including a SORT function. They are available now to people on the Insiders program. They promise to release them to Excel 365 users "soon", once they've tested them better. This formula would be pretty simple using those.

"Simple VBA" eh...this will take me a week to understand this code lol. I took your advice and started learning/applying VBA at work earlier this year, though I'm not at this level yet...Thanks for sharing though Eric, I'm going to try it out tmrw at work. Today I was actually able to use the built in Sort and it surprisingly worked (slowly), but it worked. This code method would be much preferred though.

Yes, I'd like to see those new functions too for instances like this. Sort, Unique, XMATCH, XLOOKUP, they all look promising but I hope XMATCH doesn't make all the INDEX/MATCH combo's I learnt, obsolete.

 

[JamesonMH]

Try the following, process all the records without leaving formulas on your sheet. I hope it helps you.

Sub billing_codes()
  Dim i As Long, j As Long, a, b
  Application.ScreenUpdating = False
  j = 2
  a = Range("C2:D" & Range("A" & Rows.Count).End(xlUp).Row)
  ReDim b(UBound(a))
  For i = 1 To UBound(a)
    If a(i, 1) = 1 Then
      j = i - 1
      b(j) = a(i, 2)
    Else
      b(j) = b(j) & ", " & a(i, 2)
    End If
  Next
  Range("E2").Resize(UBound(b)).Value = Application.Transpose(b)
End Sub

Thanks Dante for your time. I'm going to try your solution out tmrw too. Great to learn new code from people like you and Eric!

Cheers,
James