Concat UDF - VBA Question

[ststern45]

I wanted to ask how to change the code below so it will ignore blank cells:

The UDF works great but I receive a "value" when all the cells in a range are all blank

Function Concat(myRange As Range, Optional myDelimiter As String)
Dim r As Range

Application.Volatile
For Each r In myRange
If Len(r.Text) > 0 Then
Concat = Concat & Format(r, "000") & myDelimiter 
End If
Next r
If Len(myDelimiter) > 0 Then
Concat = Left(Concat, Len(Concat) - Len(myDelimiter))
End If
End Function

The following code works and does not result in a "value", how do I change it by adding the following line?

 Concat = Concat & Format(r, "000") & myDelimiter

Function Concat(rng As Range, Optional sep As String = ",") As String
    Dim rngCell As Range
    Dim strResult As String
    For Each rngCell In rng
        If rngCell.Value <> "" Then
            strResult = strResult & sep & rngCell.Value
        End If
    Next rngCell
    If strResult <> "" Then
        strResult = Mid(strResult, Len(sep) + 1)
    End If
    Concat = strResult
End Function

Thank you in advance!!

 

[steve the fish]

I think this works.

Function Concat(myRange As Range, Optional myDelimiter As String)

Dim r As Range

Application.Volatile

    For Each r In myRange
        If Len(r.Text) > 0 And Not (IsError(r)) Then
            Concat = Concat & Format(r, "000") & myDelimiter
        End If
    Next r

    If Right(Concat, Len(myDelimiter)) = myDelimiter Then
        Concat = Left(Concat, Len(Concat) - Len(myDelimiter))
    End If

    If Concat = 0 Then
        Concat = ""
    End If
    
End Function

 

[ststern45]

Thank you. I will check this out.

 

[Rick Rothstein]

IF the ranges you will be concatenating will be either single rows of contiguous cells, or single columns of contiguous cells, then you can use this non-looping function to perform your concatenations...

Function JoinString(varRange As Range, Optional varDelimiter As String = ",") As String
  With WorksheetFunction
    If varRange.Columns.Count = 1 Then
      JoinString = .Trim(Join(.Transpose(varRange.Value), varDelimiter))
    Else
      JoinString = .Trim(Join(.Index(varRange.Value, 1, 0), varDelimiter))
    End If
    JoinString = Replace(Replace(.Trim(Replace(Replace(JoinString, " ", Chr( _
                 1)), varDelimiter, " ")), " ", varDelimiter), Chr(1), " ")
  End With
End Function

 

[ststern45]

Thanks Rick.

Is there a way to change your code so that any numbers with a leading zero will be displayed? The range of data is all 3 digit numbers from 000 through 999. Thanks again.

 

[Rick Rothstein]

Thanks Rick.

Is there a way to change your code so that any numbers with a leading zero will be displayed? The range of data is all 3 digit numbers from 000 through 999. Thanks again.

If you had entered your values with the leading zeroes into a cell formatted as Text, or if you put an apostrophe in front of the number with leading zeroes manually typed in (to make it a Text value), then the function I posted would have worked, but if you are using Cell Formatting to display those leading zeroes, then the function I posted cannot be modified to concatenate the values using those leading zeroes (mainly because they are not really there)... you will then need to use a loop solution so that each individual value can be treated separately in accordance with what is being displayed in the cell.

 

[Rick Rothstein]

...but if you are using Cell Formatting to display those leading zeroes, then the function I posted cannot be modified to concatenate the values using those leading zeroes (mainly because they are not really there)... you will then need to use a loop solution so that each individual value can be treated separately in accordance with what is being displayed in the cell.

I found a way to write my function, still without using any loops, which will format any numbers to be three digits long with leading zeroes if necessary...

Function JoinString(Rng As Range, Optional Delimiter As String = ",") As String
  Dim EvalArg As String
  EvalArg = Replace("IF(LEN(@),IF(ISNUMBER(@),TEXT(@,""000""),@),"""")", "@", Rng.Address)
  If Rng.Columns.Count = 1 Then
    JoinString = Join(Application.Transpose(Evaluate(EvalArg)), Delimiter)
  Else
    JoinString = Join(Evaluate(EvalArg), Delimiter)
  End If
  JoinString = Replace(Replace(Application.Trim(Replace(Replace(JoinString, " ", _
                       Chr(1)), Delimiter, " ")), " ", Delimiter), Chr(1), " ")
End Function