Help : Join String with Delimiter - need to have the option of downward or rightward

Hi,

Thanks for the continued support from all the expert members in VBA Express
This time I would like have an option to choose the route to join strings.

Currently the code is joining values from the right first, I need to have option to choose whether the joinstring shall go downwards or rightwards.

http://www.vbaexpress.com/forum/imag...AAAElFTkSuQmCC

Code:

---

Option Explicit


Sub JoinString()
    Dim xJoinRange As Range, xDestination As Range, Rng As Range
    Dim Delimiter As String, OutputValue As String
       
    On Error Resume Next
    'Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
    Set xJoinRange = Selection
    'On Error GoTo 0
   
    'If xJoinRange Is Nothing Then Exit Sub
     
    Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)
         
    Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)
       
    For Each Rng In xJoinRange
    If Len(Trim(Rng.Value)) = 0 Then GoTo NextCell
    OutputValue = OutputValue & Rng.Value & Delimiter
NextCell:
    Next
   
    xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))
    On Error GoTo 0
   
End Sub

---

Try this

Attachment 27527

Green = input
Yellow = Left to Right
Orange = Right to Left

Code:

---

Option Explicit


Sub JoinString()
    Dim xJoinRange As Range, xDestination As Range, Rng As Range
    Dim Delimiter As String, OutputValue As String
    Dim bUp As Boolean
    Dim n As Long
       
    On Error Resume Next
    Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
    If xJoinRange Is Nothing Then Exit Sub
    On Error GoTo 0
   
    On Error Resume Next
    Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)
    If xDestination Is Nothing Then Exit Sub
    On Error GoTo 0
   
    Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)
       
    bUp = (MsgBox("In Normal Left to Right order?", vbQuestion + vbYesNo, "Up or Down") = vbYes)
   
    If bUp Then
        For n = 1 To xJoinRange.Cells.Count
            If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
                OutputValue = OutputValue & xJoinRange.Cells(n).Value & Delimiter
            End If
        Next
   
    Else
        For n = xJoinRange.Cells.Count To 1 Step -1
            If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
                OutputValue = OutputValue & xJoinRange.Cells(n).Value & Delimiter
            End If
        Next
    End If
   
    xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))
   
End Sub

---

Thanks Paul_Hossler
Sorry for the confusion. Downwards I mean as highlighted in blue below
Attachment 27529
http://www.vbaexpress.com/forum/imag...AAAElFTkSuQmCC

Thankyou very much Paul_Hossler

I have made few changes in the code as given below

Code:

---

    bUp = (MsgBox("Each cell value in new line with numbering ?", vbQuestion + vbYesNo, "Up or Down") = vbYes)
   
    If bUp Then
        For n = 1 To xJoinRange.Cells.Count
            If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
                OutputValue = OutputValue & "(" & n & ") " & xJoinRange.Cells(n).Value & Delimiter & Chr(10)
            End If
        Next
   
    Else
        Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)
        For n = 1 To xJoinRange.Cells.Count
            If Len(Trim(xJoinRange.Cells(n).Value)) > 0 Then
                OutputValue = OutputValue & xJoinRange.Cells(n).Value & Delimiter
            End If
        Next
    End If
   
    xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))

---

That's OK, but I suggest the following to ensure that you're going in the right direction

Code:

---

Option Explicit


Sub JoinString()
    Dim xJoinRange As Range, xDestination As Range, Rng As Range
    Dim Delimiter As String, OutputValue As String
    Dim bRows As Boolean
    Dim r As Long, c As Long
       
    On Error Resume Next
    Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
    If xJoinRange Is Nothing Then Exit Sub
    On Error GoTo 0
   
    On Error Resume Next
    Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)
    If xDestination Is Nothing Then Exit Sub
    On Error GoTo 0
   
    Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)
       
    bRows = (MsgBox("[Yes] = Across Rows, [No] = Down Columns", vbQuestion + vbYesNo, "Up or Down") = vbYes)
   
    If bRows Then
        For r = 1 To xJoinRange.Rows.Count
            For c = 1 To xJoinRange.Columns.Count
                If Len(Trim(xJoinRange.Cells(r, c).Value)) > 0 Then
                    OutputValue = OutputValue & xJoinRange.Cells(r, c).Value & Delimiter
                End If
            Next c
        Next r
   
    Else
        For c = 1 To xJoinRange.Columns.Count
            For r = 1 To xJoinRange.Rows.Count
                If Len(Trim(xJoinRange.Cells(r, c).Value)) > 0 Then
                    OutputValue = OutputValue & xJoinRange.Cells(r, c).Value & Delimiter
                End If
            Next r
        Next c
    End If
   
    xDestination.Value = Left(OutputValue, Len(OutputValue) - Len(Delimiter))
   
End Sub

---

Attachment 27533

THANKS A TON Paul_Hossler

If you've got a version of Excel with TEXTJOIN available as a worksheet function then the likes of:
=TEXTJOIN(",",TRUE,C4:E15)
or the other way:
=TEXTJOIN(",",TRUE,TRANSPOSE(C4:E15))
might do it for you.

p45cal

:thumb:thumb:thumb - you can take the rest of the day off

anish.ms

If you need some VBA to include as part of a larger project, this is how I'd merge p45cal's into the earlier one

Code:

---


Option Explicit


Sub JoinString()
    Dim xJoinRange As Range, xDestination As Range
    Dim Delimiter As String
    Dim bRows As Boolean
       
    On Error Resume Next
    Set xJoinRange = Application.InputBox(prompt:="Select source cells to merge", Type:=8)
    If xJoinRange Is Nothing Then Exit Sub
    On Error GoTo 0
   
    On Error Resume Next
    Set xDestination = Application.InputBox(prompt:="Select destination cell", Type:=8)
    If xDestination Is Nothing Then Exit Sub
    On Error GoTo 0
   
    Delimiter = Application.InputBox(prompt:="Delimiter", Type:=2)
       
    bRows = (MsgBox("[Yes] = Across Rows, [No] = Down Columns", vbQuestion + vbYesNo, "Up or Down") = vbYes)
   
    With Application.WorksheetFunction
        If bRows Then
            xDestination.Value = .TextJoin(Delimiter, True, xJoinRange)
        Else
            xDestination.Value = .TextJoin(Delimiter, True, .Transpose(xJoinRange))
        End If
    End With
   
End Sub

---

Thanks p45cal for your response
Yes, i'm aware of the Textjoin function
But some times when I convert pdf to excel with 100's of line items, macro will be more helpful to join the texts and it is nice to have in the personal.xlsb

:thumb
Can you look at the following scenario
If delimiter is left blank and click cancel instead of ok button in input box, False is appearing in b/w the cell values

Hi Paul_Hossler
I was trying to do it with the help of user form with more options based on my limited understating from your text to case user forms, but could not succeed :(

Code:

---

Sub M_snb()
  sn = Range("A1:B8")
   
  For j = 1 To UBound(sn, 2)
    c00 = c00 & " " & Join(Application.Index(Application.Transpose(sn), j))
  Next
   
  MsgBox c00
End Sub

---

NB. Avoid 'Worksheetfunction', in several cases it contains bugs. 'Application' suffices.

Play with this

I added Source range and Destination cell to the user form along with the delimitator

Note that the RefEdit control and not Textbox is used to enter the 2 ranges

I simplified the operation selection by removing the eNum and passing paramters to the JoinString sub

Attachment 27535

Superb :clap:Thanks a lot Paul_Hossler :bow:
Let me learn from your codes :think:

It is working perfectly in this workbook. But if I export both the form and module to my PERSONAL.XLSB, I'm getting error at Call JoinString

Works OK here

What kind of error?

Attachment 27545

Yes, it is working fine now. It seems if i change the module name to JoinString then it is not working :think:

Quote:

---

if i change the module name to JoinString

---

:devil2:

Quote:

---

Originally Posted by anish.ms

Yes, it is working fine now. It seems if i change the module name to JoinString then it is not working :think:

---

That's because the sub is also called 'JoinString' and Excel gets confused with what are essentially 2 variables called the same

Call the module 'mod_JoinString' instead

:thumb