1
votes

So I have the code that pastes multiple values into one cell but I was hoping to be able to put a semicolon in between the cell's value.

This code allows a vlookup to find multiple cell values and output them in one cell.

Function MYVLOOKUP(pValue As String, pWorkRng As Range, pIndex As Long)
'Update 20150310
Dim rng As Range
Dim xResult As String
xResult = ""
For Each rng In pWorkRng
    If rng = pValue Then
        xResult = xResult & ";" & rng.Offset(0, pIndex - 1)
    End If
Next
MYVLOOKUP = xResult
End Function

When I do this it does put a semicolon in between the values like I want, but also has a billion semicolons after.

2
Can you put Debug.Print rng.Offset(0, pIndex - 1) before xResult = xResult & ";" & rng.Offset(0, pIndex - 1) and see what that's returning?dwirony
If you have Office 365: =TEXTJOIN(";",TRUE,IF(A1:A1000="MyValue",D1:D1000,"")) As an Array Formula with Ctrl-Shift-EnterScott Craner
@dwirony it still has a bunch of ; afterPaige Hilliard
@scott craner where am I adding that?Paige Hilliard
it is a formula that you add on the sheet changing the ranges to the desired input and output, it is not vbaScott Craner

2 Answers

1
votes

I'd work with an array for this. Start by sizing it to fit the entire source:

Dim results As Variant
ReDim results(1 To pWorkRng.Count)

Then maintain a counter for the index of the last item in that array, and write at that index:

Dim currentIndex As Long

For Each rng In pWorkRng
    If Not IsError(rng.Value) Then
        If rng.Value = pValue Then
            currentIndex = currentIndex + 1
            results(currentIndex) = rng.Offset(0, pIndex - 1)
        End If
    End If
Next

When the loop completes, you'll have all the results up to currentIndex, and then a bunch of Empty values; truncate the array with ReDim Preserve:

ReDim Preserve results(1 To currentIndex)

And now you can return a string with all the results, using String.Join:

MYVLOOKUP = String.Join(results, ";")
0
votes

If Mathieu Guindons method doesn't work then, try to add the following to your code after the following line:

xResult = xResult & ";" & rng.Offset(0, pIndex - 1)

    Do While (InStr(xResult, ";;") > 0)
        xResult = Replace(xResult, ";;", ";")
    Loop