Generate Comma Separated string from columns based on condition in Excel using VBA

nainil used Ask the Experts™
I have three columns in Excel:

Sheet		Errors			Status
Codes		15 Errors found		Yes
Names		250 Errors found	No
Details		No Error		Yes
Sheet4		No			No

Open in new window

I want to generate a comma separated string from the first column where status='Yes'.

For eg, 'Codes, Details' should be generated
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
I can't think of a way for Excel to handle this directly, but you could run a macro to handle it, either as an Excel-extended function or a subroutine to put the result in a message box or location of your choice (e.g. cell)

Add this code to the VBA area of this sheet and run it:

Sub GetList()
   Dim objCell As Range
   Dim strResult As String

    strResult = ""
    For Each objCell In Range("C:C")
        If objCell.Value = "" Then
            Exit For
        End If
        If UCase(objCell.Value) = "YES" Then
            strResult = strResult & "," & Cells(objCell.Row, 1).Value
        End If
    MsgBox Mid(strResult, 2)
End Sub

Open in new window

Top Expert 2010

This seems to be working for me.  It relies on the AUtoFilter to do its voodoo:

Sub MakeTheString()
    Dim LastR As Long
    Dim LastC As Long
    Dim Result As String
    Result = "<No data found!>"
    With ActiveSheet
        LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Cells(1, LastC + 1) = "Original"
        With .Range(.Cells(2, LastC + 1), .Cells(LastR, LastC + 1))
            .Formula = "=ROW(A1)"
            .Value = .Value
        End With
        .[a1].Sort Key1:=.[c1], Key2:=.Cells(1, LastC + 1), Order1:=xlAscending, Order2:=xlAscending, _
        .[a1].AutoFilter 3, "Yes", xlAnd
        On Error Resume Next
        Result = Join(Application.Transpose(.Range(.Cells(2, 1), .Cells(LastR, 1)).SpecialCells(xlCellTypeVisible)), ", ")
        On Error GoTo 0
        .[a1].Sort Key1:=.Cells(1, LastC + 1), Order1:=xlAscending, Header:=xlYes
        .Cells(1, LastC + 1).EntireColumn.Delete
    End With
    MsgBox Result
End Sub

Open in new window


Works as expected.
Thank you for your help!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial