Thread: Need list of unique values for sumiff'ed records

Try adding this UDF to your VB Editor (ALT+F11, Insert|Module)

Function aconcat(a As Variant, Optional sep As String = "") As String
' Harlan Grove, Mar 2002
Dim y As Variant

If TypeOf a Is Range Then
For Each y In a.Cells
aconcat = aconcat & y.Value & sep
Next y
ElseIf IsArray(a) Then
For Each y In a
aconcat = aconcat & y & sep
Next y
Else
aconcat = aconcat & a & sep
End If

aconcat = Left(aconcat, Len(aconcat) - Len(sep))
End Function

Then in K5 enter formula:

=SUBSTITUTE(TRIM(aconcat(IF($E$2:$E$51=I5,$F$2:$F$51,"")," "))," ",", ")

confirmed with CTRL+SHIFT+ENTER not just ENTER and copied down.

Hi

I think the code below will do what you want.
Also attached your workbook with the code added

Option Explicit

Sub CollectInvoices()
    Dim i As Long, lr As Long
    Dim str As String, R As Range, start As String
    Sheets("Sheet1").Activate
        lr = Cells(Rows.Count, 6).End(xlUp).Row
        For i = 1 To WorksheetFunction.Max(Columns(9))

            With Range("E2:E" & lr)

                Set R = .Find(i, , xlValues, xlWhole)
                If Not R Is Nothing Then
                    start = R.Address
                    R.Select
                    Do
                        If InStr(str, R.Offset(0, 1).Value) < 1 Then
                            str = str & R.Offset(0, 1).Value & ", "
                        End If
                        Set R = .FindNext(R)
                    Loop While Not R Is Nothing And R.Address <> start
                End If

            End With
            Cells(i + 4, "K") = Left(str, Len(str) - 2)
            str = ""
        Next
    
End Sub

With my suggestion you don't need to know the cells to reference.. The UDF in the VBEditor is acts like a regular function...

After you paste the code in the editor, then you use the ACONCAT() function like any other Excel function...

Syntax: ACONCAT(range,separator)

I used it nested within and IF and SUBSTITUTE and TRIM in order to get it down to comma separators with no commas at the end....

Try it...

Hi Scott

Only just spotted your request.
I think the attached file with the modified code as below does what you want.

Sub CollectInvoices()
    Dim i As Long, lrd As Long, lrm As Long
    Dim str As String, R As Range, start As String
    Dim wsd As Worksheet, wsm As Worksheet
    Set wsd = Sheets("All data entry")
    Set wsm = Sheets("Summary")
    Application.EnableEvents = False
    lrd = wsd.Cells(Rows.Count, "K").End(xlUp).Row
    lrm = wsm.Cells(Rows.Count, "G").End(xlUp).Row

    For i = 1 To lrm
        wsd.Activate
        With wsd.Range("K2:K" & lrd)

            Set R = .Find(i, , xlValues, xlWhole)
            If Not R Is Nothing Then
                start = R.Address
                R.Select
                Do
                    If InStr(str, R.Offset(0, 2).Value) < 1 Then
                        str = str & R.Offset(0, 2).Value & ", "
                    End If
                    Set R = .FindNext(R)
                Loop While Not R Is Nothing And R.Address <> start
            End If

        End With
        If Not str = "" Then
            wsm.Cells(i + 9, "L") = Left(str, Len(str) - 2)
            str = ""
        End If
    Next
    Application.EnableEvents = True
End Sub

Hi Scott

It is just a question of adding another Case statement to the event code that you have on the data entry sheet.

Event code (in this case the change of a value in a cell) is triggered by the fact that an alteration has taken place in a specified range.
You are using the range of Target.column so it is just a simple addition to your code as shown below

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
    Case 1  ' columns C & E are 3rd & 5th columns
        TypedVal = Application.WorksheetFunction. _
            Text(Target.Value, "000000")
        NewValue = Left(TypedVal, 2) & "/" & _
            Mid(TypedVal, 3, 2) & "/" & _
            Right(TypedVal, 2)
    Case 5, 6 ' Columns E & F are time columns
        TypedVal = Application.WorksheetFunction. _
            Text(Target.Value, "0000")
        NewValue = Left(TypedVal, 2) & ":" & _
            Right(TypedVal, 2)
    Case 13  ' change in the Invoice # column (M)
            Call CollectInvoices
            
    Case Else
    
    End Select
    If NewValue > 0 Then
        Application.EnableEvents = False
        Target.Value = NewValue
        Application.EnableEvents = True
    End If
End Sub

If a value changes in column M, then my macro will be called and run.