Concatenate the values in one column separated by '/' based on the values assigned to the another column

Question

I have an excel sheet which contains two columns called ProductName and CountryCode.i wanted to concatenate all the CountryCode separated by / based on the corresponding values in the column 'ProductName' and My output would be obtained in a separate column called 'FinalResults'. Please note that I used remove duplicate function to get unique values in Column C from Column A.

I tried the below VBA code with the help of stackoverflow and got the results.

Sub ProductCountry()    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")    
    Dim FoundCell As Range, SearchRange As Range, Names As Range, SearchCell As Range
    Dim MyString As String, i As Long

    Set SearchRange = ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
        SearchRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("C2"), Unique:=True
        ws.Range("C2").Delete Shift:=xlShiftUp

    Set Names = ws.Range("C2:C" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)

    For Each SearchCell In Names
        Set FoundCell = SearchRange.Find(SearchCell)
            For i = 1 To Application.WorksheetFunction.CountIf(SearchRange, SearchCell)
                MyString = MyString & FoundCell.Offset(, 1) & "/"
                Set FoundCell = SearchRange.FindNext(FoundCell)
            Next i
        SearchCell.Offset(, 1) = Left(MyString, Len(MyString) - 1)
        MyString = ""
    Next SearchCell
End Sub

Seems it works fine except for the first product PRO1. You could see it didn't concatenate the codes orderly and skipped the country code US and took the country code SG two times instead.

Can anyone help what went wrong in this script and I also got range error sometime if I use this same code for large data.

see here: https://stackoverflow.com/questions/54582741/excel-return-range-of-values-based-on-criteria — Scott Craner, Apr 01 '19 at 14:04

Skin · Answer 1 · 2019-04-01T11:00:00.210

I rewrote it ...

Public Function ConcatenateCodes(ByVal strProductName As String, ByVal rngCells As Range, Optional ByVal strDelimiter As String = "/") As String
    Application.Volatile

    Dim objCell As Range, lngRow As Long, lngCol As Long, strThisProductName As String
    Dim strCountry As String, lngBlank As Long

    For lngRow = 1 To rngCells.Rows.Count
        strThisProductName = Trim(rngCells.Cells(lngRow, 1))
        strCountry = Trim(rngCells.Cells(lngRow, 2))

        If strThisProductName & strCountry = "" Then
            lngBlank = lngBlank + 1
        Else
            lngBlank = 0

            If strProductName = strThisProductName Then
                ConcatenateCodes = ConcatenateCodes & strDelimiter & strCountry
            End If
        End If

        If lngBlank = 10 Then Exit For
    Next

    If ConcatenateCodes <> "" Then ConcatenateCodes = Mid(ConcatenateCodes, 2)
End Function

... I'm comfortable with the above but that's just me. It means the data doesn't need to be sorted and it will work.

Add the formula to your cell and watch it go.

score 0 · Answer 2 · answered Apr 01 '19 at 11:24

If you concern about speed you should use arrays to handle your data:

Option Explicit

Public Sub CollectList()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet2")

    'read values into array
    Dim InputValues() As Variant
    InputValues = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0, 1)).Value

    Dim UniqueList As Object
    Set UniqueList = CreateObject("Scripting.Dictionary")

    'collect all products in a dictionary
    Dim iRow As Long
    For iRow = 1 To UBound(InputValues, 1)
        If UniqueList.Exists(InputValues(iRow, 1)) Then
            UniqueList(InputValues(iRow, 1)) = UniqueList(InputValues(iRow, 1)) & "/" & InputValues(iRow, 2)
        Else
            UniqueList.Add InputValues(iRow, 1), InputValues(iRow, 2)
        End If
    Next iRow

    'output dictionary into cells
    iRow = 2 'start output in row 2
    Dim itm As Variant
    For Each itm In UniqueList
        ws.Cells(iRow, "C").Value = itm
        ws.Cells(iRow, "D").Value = UniqueList(itm)
        iRow = iRow + 1
    Next itm
End Sub

score 0 · Answer 3 · answered Apr 01 '19 at 11:40

As can be seen by the other responses, there are many ways to accomplish your task.

But read VBA HELP for the Range.Find method I submit the following to help you understand where you went wrong:

This is your problem line:

Set FoundCell = SearchRange.Find(SearchCell)

You only specify the what argument for the Find. So other arguments default to some uncontrolled value. In general, the after argument will default to the beginning of the range, so the first matching term you will Find for PRO1 will be in A3. Also, the 2nd SG is being picked up because the lookat is defaulting to xlPart and PRO1 is contained within PRO10.

So one way of correcting that portion of your code, would be to be sure to specify all the relevant arguments of the Find. eg:

Set FoundCell = SearchRange.Find(what:=SearchCell, after:=SearchRange.End(xlDown), lookat:=xlWhole)

Concatenate the values in one column separated by '/' based on the values assigned to the another column

3 Answers3