Adding a loop that will conditionally concatenate text with a definable separator

Question

I have the following macro:

Function EndOfMonth(ByVal d As Date, ByVal n As Long) As Date

            d = DateAdd("m", n + 1, d)

            EndOfMonth = d - Day(d)

End Function

Sub Create_File()

Dim CreatedFile As String

Dim textdata As Long, i As Long

Dim ClientName As Range

i = 1

For Each ClientName In Range("Client_Name")

CreatedFile = "C:" & ClientName.Value & " Created File.txt"

textdata = FreeFile()

Open CreatedFile For Output As textdata

Print #textdata, "test text"

Print #textdata, "      indented text" & Chr(34) & "text in quotes" & Chr(34) & " ending text"

If Range("Testing_Range1") <> 0 _

Then Print #textdata, "Test Range 1 = " & _

& Format(Range("Testing_Range1")(i).Value, "0.00")

Print #textdata, "Beginning of range starts at the following date: " & _

    Format(EndOfMonth(Range("Client_Date")(i).Value, -12) + 1, "mmmm d")

Print #textdata, "Ending of range ends at the following date:  " & _

    Format(Range("Client_Date")(i).Value, "mmmm d")

Print #textdata, "Allowable Employees: " & Range("Employee_List")(i).Value

i = i + 1

Next ClientName

End Sub

It does everything as intended, except for the way the "Employee_List" range is handled. "Employee_List" is a named range of a single column of 100 rows. Each of the cells will either have a text result or "".

Currently, the macro will only list the text in the first row of the range. What I would like to do is have all cells in the range that contain text concatenate with a comma and space separator (", "), ignoring the blanks ("") in the range.

I tried writing a formula to take strings and define a separator to do the concatenation, but I couldn't get any proper results.

Any help would be appreciated.

Bryan

Answer 1

Try feeding this function with your named range:

Function ConcAllNonBlankCellsInRange(rng As Range) As String

    Dim c As Range

    Dim strComma As String, strOut As String

    strComma = ""

    For Each c In rng

        If c.Value <> "" Then

            strOut = strOut & strComma & c.Value

            strComma = ", "

        End If

    Next c

    ConcAllNonBlankCellsInRange = strOut

End Function

Sub Example()

    string = ConcAllNonBlankCellsInRange(Range("Employee_List"))

End Sub

Hope that helps.

Cheers

Rich

Answer 2

I have the following macro:

Function EndOfMonth(ByVal d As Date, ByVal n As Long) As Date

            d = DateAdd("m", n + 1, d)

            EndOfMonth = d - Day(d)

End Function

Sub Create_File()

Dim CreatedFile As String

Dim textdata As Long, i As Long

Dim ClientName As Range

i = 1

For Each ClientName In Range("Client_Name")

CreatedFile = "C:" & ClientName.Value & " Created File.txt"

textdata = FreeFile()

Open CreatedFile For Output As textdata

Print #textdata, "test text"

Print #textdata, "      indented text" & Chr(34) & "text in quotes" & Chr(34) & " ending text"

If Range("Testing_Range1") <> 0 _

Then Print #textdata, "Test Range 1 = " & _

& Format(Range("Testing_Range1")(i).Value, "0.00")

Print #textdata, "Beginning of range starts at the following date: " & _

    Format(EndOfMonth(Range("Client_Date")(i).Value, -12) + 1, "mmmm d")

Print #textdata, "Ending of range ends at the following date:  " & _

    Format(Range("Client_Date")(i).Value, "mmmm d")

Print #textdata, "Allowable Employees: " & Range("Employee_List")(i).Value

i = i + 1

Next ClientName

End Sub

It does everything as intended, except for the way the "Employee_List" range is handled. "Employee_List" is a named range of a single column of 100 rows. Each of the cells will either have a text result or "".

Currently, the macro will only list the text in the first row of the range. What I would like to do is have all cells in the range that contain text concatenate with a comma and space separator (", "), ignoring the blanks ("") in the range.

I tried writing a formula to take strings and define a separator to do the concatenation, but I couldn't get any proper results.

Any help would be appreciated.

Bryan

Vill the following function do what you ask for?

Function empl_list(r As Range) As String

  Dim result As String

  result = ""

  For Each c In r

     If c.Value <> "" Then

       result = result & ", " & c.Value

     End If

  Next c

  empl_list = Mid(result, 3, 9999)

End Function

Sub test()

  MsgBox empl_list(Range("Employee_List"))

End Sub

Hope this helps / Lars-Åke

Answer 3

This works as well!

Much obliged!

Answer 4

EXACTLY what I needed!

Thank you very much!