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!