Solved: Parse cell data into seperate columns

[grichey]

Hello,

I am trying to take a set of records that include a name followed by another cell that is a list of attributes seperated by ; 's. I have included a file with what I'm trying to do.

The goal is to seperate the 2nd column into 0's and 1's based on whether or not the name has that attribute.

There will always be a name called dummy that has every possible attribute so the # of columns in the output sheet is dynamic.

Suggestions??

Thanks

[GTO]

Have you tried:

=--ISNUMBER(SEARCH("ART",B3))

Mark

[grichey]

yea --- that would work for getting the 1's and 0's.

Suggestions on getting the columns split out from the dummy variable?

[GTO]

Ohhh.....OOPSIE :-(

I sorta missed that part. Is vba okay?

[grichey]

Here's a better example maybe. I'm trying to get to the desired outcome via macro without having all the formulas just loaded in because the number of Subjects might change.

[grichey]

Ohhh.....OOPSIE :-(

I sorta missed that part. Is vba okay?

Ya - vba is what i'm going for. Just having trouble with setting it up.

[GTO]

Hey Gavin,

See if this is what you are looking to accomplish. This goes with the attachment at post #5.

Option Explicit
    
Sub exa()
Dim _
wksORIG         As Worksheet, _
wksOUT          As Worksheet, _
rngFind         As Range, _
rngAttVals      As Range, _
aryClassList    As Variant, _
lCols           As Long, _
i               As Long
    
    Set wksORIG = Worksheets("Original Data")
    
    wksORIG.Copy After:=wksORIG
    Set wksOUT = ActiveSheet
    
    With wksOUT
        Set rngFind = .Range("C2:C" & Rows.Count).Find(What:="dummy", _
                                                       After:=.Range("C2"), _
                                                       LookIn:=xlValues, _
                                                       LookAt:=xlWhole, _
                                                       SearchOrder:=xlByRows, _
                                                       SearchDirection:=xlNext, _
                                                       MatchCase:=False)
        If rngFind Is Nothing Then
            Application.DisplayAlerts = False
            wksOUT.Delete
            Application.DisplayAlerts = True
            MsgBox "Dummy not found; exiting...", 0, vbNullString
            Exit Sub
        Else
            wksOUT.Name = "Output Data"
            aryClassList = Application.Trim(Split(rngFind.Offset(, 1).Value, ";"))
            lCols = UBound(aryClassList) - LBound(aryClassList) + 1
            rngFind.EntireRow.Delete xlShiftUp
        End If
        
        With .Range("E1").Resize(, lCols)
            .Value = aryClassList
            .EntireColumn.AutoFit
        End With
        
        Set rngFind = .Range("C2:C" & Rows.Count).Find(What:="*", _
                                                       After:=.Range("C2"), _
                                                       LookIn:=xlValues, _
                                                       LookAt:=xlPart, _
                                                       SearchOrder:=xlByRows, _
                                                       SearchDirection:=xlPrevious)
        Set rngAttVals = .Range("E2").Resize(rngFind.Row - 1, lCols)
        
        For i = 1 To rngAttVals.Columns.Count
            rngAttVals.Columns(i).Formula = _
                "=--ISNUMBER(SEARCH(""" & _
                 rngAttVals.Cells(1, Columns(i).Column).Offset(-1).Value & """,D2))"
        Next
        
        '// IF you want just the values left...
        rngAttVals.Value = rngAttVals.Value
    End With
End Sub

Hope that helps,

Mark

[grichey]

Thx!