Return all billing codes billed per customer visit

JamesonMH

Board Regular
Joined
Apr 17, 2018
Messages
111
Office Version
  1. 365
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).

ABCDE
1CustomerDateDistinct customer visit? (yes = 1)Code billedCodes billed per customer visit
2ABCSep 011499J499J, 550M
3ABCSep 01550M
4DEFSep 021425H425H
5DEFSep 051690B690B, 701T, 499J, 880Q
6DEFSep 05701T
7DEFSep 05499J
8DEFSep 05880Q
9GHHSep 081701T701T, 499J
10GHHSep 08499J

<tbody>
</tbody>

Many thanks for reading through and your time!

James
 

JamesonMH

Board Regular
Joined
Apr 17, 2018
Messages
111
Office Version
  1. 365
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:

Code:
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.
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

JamesonMH

Board Regular
Joined
Apr 17, 2018
Messages
111
Office Version
  1. 365
Try the following, process all the records without leaving formulas on your sheet. I hope it helps you.

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,128,069
Messages
5,628,468
Members
416,319
Latest member
k8o2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top