VBA or formula to group values for each unique reference

[Trebor8484]

Hi,

I have a table with a list of job references, after sorting the table by job ref then date I am trying to group the job type prefixes into as single cell.

Does anyone have any suggestions for doing this either with VBA or a formula please see example below in the end column and file attached for reference.

easyupload.io

Thanks

 

[Trebor8484]

I have solved this for anone who may be interested in future.

Needs to be an array formula if using Excel prior to 365 version

=IF([@[Unique Ref]]="","",TEXTJOIN(" > ", TRUE, IF([@[Unique Ref]]=[Unique Ref],[Job Jype],"")))

And a UDF if using a version of Excel that doesn't support TEXTJOIN

'Name user defined function and define parameters
Function Lookup_concat(Search_string As String, Search_in_col As Range, Return_val_col As Range)

    'Dimension variables and declare data types
    Dim i As Long
    Dim result As String
    Dim delim As String
    
    'Set the seperator value
    delim = " > "
    'delim = " "

    'Iterate through each cell in search column
    For i = 1 To Search_in_col.Count
        'Check if cell is equal to search string
        If Search_in_col.Cells(i, 1) = Search_string Then
            'Concatenate corresponding value on the same row to the result variable
            'result = result & " " & Return_val_col.Cells(i, 1).Value
            result = result & delim & Return_val_col.Cells(i, 1).Value
        End If
    'Continue with next cell
    Next

    'Return variable to worksheet
    If delim <> " " Then
        Lookup_concat = Trim(Mid(result, Len(delim), Len(result)))
    Else
        Lookup_concat = Trim(result)
    End If
    
End Function

 

[Peter_SSs]

And a UDF if using a version

Here is another UDF version that I think does the same job.

Function ConcatJobType(rRef As Range, rJT As Range, sRef As String) As String
  ConcatJobType = Mid(Replace(Join(Filter(Application.Transpose(Evaluate(rRef.Address & "&""> ""&" & rJT.Address)), sRef)), sRef, ""), 3)
End Function

Trebor8484.xlsm
	A	B	C	D	E
1	Unique Ref	Case Count	Assigned Time	Job Jype	Job Sequence
2	615203064478	1	5/10/2021 8:13	G	G > v
3	615203064478	0	7/10/2021 8:28	v	G > v
4	615203082759	1	7/10/2021 17:53	G	G > G
5	615203082759	0	7/10/2021 19:32	G	G > G
6	615203200385	1	27/11/2021 9:53	G	G > v
7	615203200385	0	27/11/2021 13:52	v	G > v
8	615203309433	1	5/10/2021 9:23	v	v > v
9	615203309433	0	5/10/2021 11:13	v	v > v
10	615203334112	1	7/10/2021 17:51	v	v > G
11	615203334112	0	8/10/2021 8:23	G	v > G
12	615203334110	1	7/10/2021 8:28	G	G > v > G
13	615203334110	0	7/10/2021 17:53	v	G > v > G
14	615203334110	0	7/10/2021 19:32	G	G > v > G
Sheet1

Cell Formulas
Range	Formula
E2:E14	E2	=ConcatJobType([Unique Ref],[Job Jype],[@[Unique Ref]])

 

[Trebor8484]

Thanks for the shorter one line UDF

One problem with all of these and the formula is that they run very slowly on 45,000 rows of data.

Is there any way I can store these as keys in a dictionary and write them to the sheet in one go at the end?

 

[Peter_SSs]

Judging by your post 2 formula, I have assumed the data is in a formal table. Mine is called "Table2" so adjust the code to match your table name.
I have also assumed that the (empty) "Job Sequence" column already exists in the table.
Test with a copy of your workbook.

Sub JobSequence()
  Dim d As Object
  Dim Ref As Variant, JobJype As Variant, JobSeq As Variant
  Dim i As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  Ref = Range("Table2[Unique Ref]").Value
  JobJype = Range("Table2[Job Jype]").Value
  ReDim JobSeq(1 To UBound(Ref), 1 To 1)
  For i = 1 To UBound(Ref)
      If Len(Ref(i, 1)) > 0 Then d(Ref(i, 1)) = d(Ref(i, 1)) & " > " & JobJype(i, 1)
  Next i
  For i = 1 To UBound(Ref)
    If Len(Ref(i, 1)) > 0 Then JobSeq(i, 1) = Mid(d(Ref(i, 1)), 4)
  Next i
  Range("Table2[Job Sequence]").Value = JobSeq
End Sub

 

[Trebor8484]

Thanks, works perfectly. Ran in 8 seconds instead of 10 minutes when using the UDF's.

 

[Peter_SSs]

Sounds like a good improvement.
Thanks for letting us know.