Consulting

Results 1 to 19 of 19

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

  1. #1
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location

    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.




    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
    Attached Files Attached Files
    Last edited by anish.ms; 12-03-2020 at 07:33 AM. Reason: attachment missed

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Try this

    Capture.JPG

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

    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    Thanks Paul_Hossler
    Sorry for the confusion. Downwards I mean as highlighted in blue below
    Screenshot 2020-12-03 214938.jpg
    Attached Files Attached Files
    Last edited by anish.ms; 12-03-2020 at 09:23 AM. Reason: correction

  4. #4
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    Thankyou very much Paul_Hossler

    I have made few changes in the code as given below
        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))

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    That's OK, but I suggest the following to ensure that you're going in the right direction


    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
    Capture.JPG
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    THANKS A TON Paul_Hossler

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    p45cal

    - 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



    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    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

  10. #10
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location

    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

  11. #11
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    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
    Attached Files Attached Files

  12. #12
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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.
    Last edited by snb; 12-04-2020 at 08:21 AM.

  13. #13
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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

    Capture.JPG
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #14
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    Superb Thanks a lot Paul_Hossler
    Let me learn from your codes

    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
    Last edited by anish.ms; 12-04-2020 at 11:52 AM. Reason: Changes

  15. #15
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Works OK here

    What kind of error?

    Capture.JPG
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  16. #16
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    Yes, it is working fine now. It seems if i change the module name to JoinString then it is not working

  17. #17
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    if i change the module name to JoinString

  18. #18
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by anish.ms View Post
    Yes, it is working fine now. It seems if i change the module name to JoinString then it is not working
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  19. #19
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location

    Thumbs up


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •