Concatenate excluding blank cells

[Pranesh]

Hi All,

I got the below code from a google search.. The code works perfectly fine. The code will concatenate the selected range even if it is blank. I need this code to be modified as it should skip the blank cells and only concatenate the cells which have data in a selected range. Can someone help here..

Sub Concatenate_Formula(bConcat As Boolean, bOptions As Boolean)

Dim rSelected As Range
Dim c As Range
Dim sArgs As String
Dim bCol As Boolean
Dim bRow As Boolean
Dim sArgSep As String
Dim sSeparator As String
Dim rOutput As Range
Dim vbAnswer As VbMsgBoxResult
Dim lTrim As Long
Dim sTitle As String

    'Set variables
    Set rOutput = ActiveCell
    bCol = False
    bRow = False
    sSeparator = ""
    sTitle = IIf(bConcat, "CONCATENATE", "Ampersand")
    
    'Prompt user to select cells for formula
    On Error Resume Next
    Set rSelected = Application.InputBox(Prompt:= _
                    "Select cells to create formula", _
                    Title:=sTitle & " Creator", Type:=8)
    On Error GoTo 0
    
    'Only run if cells were selected and cancel button was not pressed
    If Not rSelected Is Nothing Then
        
        'Set argument separator for concatenate or ampersand formula
        sArgSep = IIf(bConcat, ",", "&")
        
        'Prompt user for absolute ref and separator options
        If bOptions Then
        
            'vbAnswer = MsgBox("Columns Absolute? $A1", vbYesNo)
            'bCol = IIf(vbAnswer = vbYes, True, False)
            
            'vbAnswer = MsgBox("Rows Absolute? A$1", vbYesNo)
            'bRow = IIf(vbAnswer = vbYes, True, False)
                
            sSeparator = Application.InputBox(Prompt:= _
                        "Type separator, leave blank if none.", _
                        Title:=sTitle & " separator", Type:=2)
        
        End If
        
        'Create string of cell references
        For Each c In rSelected.Cells
            sArgs = sArgs & c.Address(bRow, bCol) & sArgSep
            If sSeparator <> "" Then
                sArgs = sArgs & Chr(34) & sSeparator & Chr(34) & sArgSep
            End If
        Next
        
        'Trim extra argument separator and separator characters
        lTrim = IIf(sSeparator <> "", 4 + Len(sSeparator), 1)
        sArgs = Left(sArgs, Len(sArgs) - lTrim)

        'Create formula
        'Warning - you cannot undo this input
        'If undo is needed you could copy the formula string
        'to the clipboard, then paste into the activecell using Ctrl+V
        If bConcat Then
            rOutput.Formula = "=CONCATENATE(" & sArgs & ")"
        Else
            rOutput.Formula = "=" & sArgs
        End If
        
    End If

End Sub

 

[jkpieterse]

If you are using the most recent Office 365 version you should be able to use TEXTJOIN for this.

 

[Pranesh]

Hi Jan Karel,

Thanks for your assistance. Im using Microsoft 2016 version. Can you please help me in appending the TEXTJOIN in my code?

 

[jkpieterse]

PLease check whether that function is available to you first: TEXTJOIN function

 

[Pranesh]

I checked... TEXTJOIN function is not available.