Search code examples
arraysexcelvbajoinnamed-ranges

How to join returned values from named range separated by comma


I've spent hours trying to find out how to join returned values from a named range, but the result is a

run-time error 32 - Type mismatch.

As a newbie I'm still struggling with arrays, so maybe I've overlooked some detail. Thank you for helping me out.

Example: (B1)Benzine, (B2)Diesel, (B3)Hybride -> (E1)Gasoline, (E2)Diesel, (E3)Hybrid

This is the named range:
Named Range: MOTOR

Another example (to be more clear):

Example 2: (B1)Benzine, (B3)Hybride -> (E1)Gasoline, (E3)Hybrid

Named Range: MOTOR

Option Explicit

Sub splitter()

Dim i As Long
Dim w As Long
'Dim oWB As Workbook
Dim oWS As Worksheet
Dim oWS9 As Worksheet
Dim rngMOTOR As Range
Dim rngMOTOR2 As Range
Dim arrMOTOR() As Variant
Dim LastRow As Long

'Set oWB = Workbooks("BRONBESTAND.xlsm")
Set oWS = Sheets("ONDERDELEN")
Set oWS9 = Sheets("MOTOR")                                              '5 columns: 1 Short & LONG + 1 NL + 3 Languages !!!!! WARNING

LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRow                                                                             'Starting below headers


        Set rngMOTOR = oWS.Cells(i, "M")                                                                'MOTOR      ...
        Set rngMOTOR2 = oWS9.Range("MOTOR")                                                 'MOTOR2: MOTOR - Bronbestand       arrPOS = rngPOS2.Value

        arrMOTOR = rngMOTOR2.Value


'*********
Dim txt As String
Dim j As Integer
Dim Splitted As Variant
Dim arrMOTORall As Variant
Dim arrMOTORsplit As Variant
Dim Motor3 As String

txt = oWS.Cells(i, "M")                                                                'MOTOR      ...

        Debug.Print ("txt : ") & i & ": "; txt

    If Not IsEmpty(txt) Then

        Splitted = Split(txt, ", ")
        For j = 0 To UBound(Splitted)

                Cells(1, j + 1).Value = Splitted(j)
                        Debug.Print ("                ---> Splitted: ") & Splitted(j)

        '**** INSERT *****


                For w = LBound(arrMOTOR) To UBound(arrMOTOR)
                    If arrMOTOR(w, 1) = Splitted(j) Then                                                                    'EX: B - Benzine
                            arrMOTORsplit = (arrMOTOR(w, 4))                                                               '(arrMOTOR(y, 2)) -> 1=SHORT+LONG , 2=NL, 3=FR, 4=EN
                                    Debug.Print ("                ---> arrMOTORsplit: ") & i & ": " & arrMOTORsplit

        '**** JOIN ****
                            arrMOTORall = Join(arrMOTORsplit, ", ")
                                    Debug.Print ("arrMOTORall: ") & arrMOTORall


                    End If
                Next w
        Next j
    End If

   Next i
End Sub

Solution

  • Get comma separated strings for each column in named range

    I didn't analyze your code, but this should work to receive the first three values joined

    "Benzine, Diesel, Hybride"  ' e.g. from first column 
    

    or

    "Gasoline, Diesel, Hybrid"  ' e.g. from the fourth column
    

    from a named range "Motor" via the Application.Index function.

    Notes

    The parameter 0 in this Index function indicates to not choose a specific row, the Parameter ColNo chooses each of your columns in a Loop. A subsequent transposition allows to change the 2 dimensioned array values to a 1-dim array. The Join function needs a 1-dim array and concatenates the chosen column items therein.

    Hint: The following sample code uses a fully qualified range reference assuming that you don't call the TestMe procedure from your Personal Macro Library. In the latter case you'd have to change references and workbook identification (not using ThisWorkbook!).

    Example code

    Option Explicit      ' declaration head of your code module
    
    Sub TestMe()
    Dim v As Variant, ColNo As Long
    ' assign first three rows to variant 1-based 2-dim datafield array
      v = ThisWorkbook.Worksheets("Motor").[Motor].Resize(3, 4) ' Named range value
    ' write comma separated list for each column
      For ColNo = 1 To 4
          Debug.Print Join(Application.Transpose(Application.Index(v, 0, ColNo)), ", ")
      Next ColNo
    End Sub
    

    EDIT - Flexible Search in ANY ORDER to translate joined lists

    This solution allows to return joined search words in any combination using the Application.Index function in an advanced way using row and column arrays as parameters. The main function getSplitters() creates a variant 2-dim array in only three steps without loops and redims and uses two language constants (Const DUTCH and Const ENGLISH).:

    1. assigns data to variant 1-based 2-dim datafield array
    2. gets only the selected rows based on comma separated string values
    3. reduces the same array to Dutch and English columns

    Calling Code

    Due to your OP the calling code anylyzes all comma separated strings in Column M in your sheet "ONDERDELEN" as far as there are values in column A. This is made by passing these found string values to the main function getSplitters with an innovative approach to get results in only three steps without Loops (see function code below).

    Translation is based on values in the named range Motor "B1:E4" in sheet "Motor" where rows comprise different sort of fuel with neighbouring columns for different languages (starting with Dutch in the first column and English in the fourth col).

    Note that using VBA it is faster to loop through an array to get values than through a range.

    Option Explicit             ' declaration head of your code module
    Const DUTCH   As Integer = 1
    Const ENGLISH As Integer = 4
    
    Sub TranslateAnyFuelCombination()
    ' Purpose: returns comma separated lists in column "M" and translates from Dutch to English
    ' Example: "Benzine, Hybride, Diesel" (Dutch) gets to "Gasoline, Hybrid, Diesel" in English
      Dim s As String
      Dim oWS As Worksheet, i&, LastRow&, vMOTOR As Variant
      Set oWS = Thisworkbook.Worksheets("ONDERDELEN")   ' fully qualified reference
    ' Get last row of wanted data
      LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
      vMOTOR = oWS.Range("M1:M" & LastRow)
      For i = 2 To LastRow                       'Starting below headers
          Debug.Print getSplitters(vMOTOR(i, 1))
      Next i
    End Sub
    

    Main function

    Function getSplitters(ByVal sRows As String) As String
      Dim i As Long, j    As Long
      Dim v As Variant, a As Variant
    ' [0] analyze selected rows string, e.g. "Benzine, Hybride, Diesel"
      a = getRowAr(sRows)          ' -> assign 1-dim Rows Array(1, 3, 2)
    ' [1] assign data to variant 1-based 2-dim datafield array
      v = Application.Transpose(ThisWorkbook.Worksheets("Motor").[Motor])      ' Named range value
    ' [2] get only selected rows, e.g. 1st, 3rd and 2nd -> in free order (!) Benzine, Hybride, Diesel
      v = Application.Transpose(Application.Index(v, _
          Application.Evaluate("row(1:" & UBound(v, 2) & ")"), _
          a))                      ' transposed columns array = selected rows
    ' [3] reduce to Dutch and English columns
      v = Application.Transpose(Application.Index(v, _
          Application.Evaluate("row(1:" & (UBound(a) + 1) & ")"), _
          Array(DUTCH, ENGLISH)))               ' selected columns array (above array retransposed)
    ' [4] return concatenated strings
      getSplitters = Join(Application.Transpose(Application.Transpose(Application.Index(v, 1, 0))), ", ") & " -> " & _
                     Join(Application.Transpose(Application.Transpose(Application.Index(v, 2, 0))), ", ")
    End Function
    

    Two helper functions

    Function getRowAr(ByVal sList As String) As Variant
    ' Purpose: split comma separated list into 1-dim number array in FREE ORDER
    ' Example: "Benzine, Hybride, Diesel" -> Array(1, 3, 2)
      Dim ar, i&
    ' change words in comma separated list to numbers
      ar = Split(Replace(sList, " ", ""), ",")
      For i = LBound(ar) To UBound(ar)
          ar(i) = val(getNumber(ar(i)))                ' change to numbers
      Next i
      getRowAr = ar                                    ' return
    End Function
    
    Function getNumber(ByVal s As String) As Long
    ' Purpose: replaces dutch search words with corresponding row number
      Dim arFuel
    ' get search words to 1-dim array
      arFuel = Application.Index(ThisWorkbook.Worksheets("Motor").[Motor], 0, DUTCH)
    ' return corresponding number
      getNumber = Application.Match(s, arFuel)
    End Function
    

    Addendum (Edit due to comment)

    The above code works as intended if you are sure that the concatenated search words (or starting parts) actually match else an Error 13 is raised. You can solve this issue in two steps:

    1. Insert an empty first row into your named range Motor (or fill it e.g. with ?, #N/A etc.)
    2. Change the 2nd helper function as follows:

    Edited function getNumber()

     Function getNumber(ByVal s As String) As Long
     ' Purpose: replaces dutch search words with corresponding row number
       Dim arFuel
     ' get search words to 1-dim array
       arFuel = Application.Index(ThisWorkbook.Worksheets("Motor").[Motor], 0, DUTCH)
     ' return corresponding number
       On Error Resume Next                             ' provide for not found case
       getNumber = Application.Match(s, arFuel, 0)      ' find only exact matches
       If Err.Number <> 0 Then getNumber = 0            ' could be omitted in case of a zero return
     End Function