Solved: Parse cell data into seperate columns

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

Have you tried:

Code:

---

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

---

Mark

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

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

Ohhh.....OOPSIE :-(

I sorta missed that part. Is vba okay?

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.

Quote:

---

Originally Posted by GTO

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.

Hey Gavin,

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

Code:

---

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

Thx!