At a loss for direction..

[braven]

Hi all,

I've got a new project and I'm really at a loss as to how to proceed. I have several different thoughts, but none of them seem right.

Here's my problem. I have a file that looks like this:

Peewee, Blue Team, First String, James Smith, 1.25
Peewee, Blue Team, First String, Johnny Jones, 1,33
Peewee, Red Team, Second String, Mikey Memphis, 1.22
Peewee, Red Team, First String, Timmy Thompson, 1.45

followed by the JV and Varsity roster in the same format (with 'Peewee' being replaced by 'JV' or 'Varsity'.

And I need to reformat this (on another tab is fine, vba is fine):

Peewee
    Blue Team
         First String
             James Smith,   1.25
             Johnny Jones,  1.33
    Red Team
         First String
             Timmy Thompson, 1.45
         Second String
             Mikey Memphis, 1.22
JV
  [etc]
Varsity
 [etc]

Any ideas on the right way to go to logically de-construct this problem? There are probably 50 teams, and over 1000 players in the full list.

[mdmackillop]

Can you post a slightly larger sample of your file. Use Manage Attachments in the Go Advanced Reply section

[braven]

I've attached a larger version. Sheet1 is the raw list, Sheet2 is what I'm hoping to get it to look like..aka, the desired result.

[p45cal]

a pivot table?
Attachment 3419only the numbers are in the data item area, the rest are all in the row area

[p45cal]

see attached

[Paul_Hossler]

Nuther way

[vba]
Option Explicit
'assumes that all data is in Col A on ActiveSheet
'in format below, seperated by commas
'Peewee, Blue Team, First String, James Smith, 1.25
'Peewee, Blue Team, First String, Johnny Jones, 1,33
Sub SplitData()
Dim rData As Range, rCell As Range
Dim v As Variant
Dim iOutputLine As Long, i As Long
Dim aLast(0 To 4) As Variant

iOutputLine = 0

Set rData = ActiveSheet.Cells(1, 1).CurrentRegion.Columns(1)
For Each rCell In rData.Cells
v = Split(rCell.Value, ",")
For i = LBound(v) To UBound(v) ' 0 - 4
If v(i) <> aLast(i) Then
If i <> 4 Then iOutputLine = iOutputLine + 1
ActiveSheet.Cells(iOutputLine, i + 2).Value = v(i)
aLast(i) = v(i)
End If
Next i
Next
End Sub
[/vba]

Formating and error checking not included

Paul

[braven]

Hi Paul,

Sorry for the long delay in reply. I'm about 5,000 miles from home on business.

Your script is almost what I need.

I've attached my workbook for review.

What I think your script is doing (which is totally "correct" based on my previous data) is checking everything up until the last slice of the array for matches. What I actually need is it to match only up to slice 2, the players team. We've removed 'string' from the data source, and added more stats.

You can see the script output in the worksheet, as well as my manually typed in 'desired output'. The red cell highlights another problem, in that if a different player's status duplicate the one above (in this case, Age), it's considered a "match" and skips to the next player.. which obviously isn't what we need since we want to only "match" on League and Team.

Also, I've been thinking of doing a 'CSV Import' to standard columns so I can manually change the data if I need to as well.. how would the script work in that case since there is no 'Split' array to loop through?

[Bob Phillips]

[vba]

Option Explicit

Sub SplitData()
Dim Player As Variant
Dim LastRow As Long
Dim i As Long, j As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1").Resize(LastRow).TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
Array(5, 1), Array(6, 1), Array(7, 1))

For i = LastRow To 1 Step -1

If .Cells(i, "B").Value = .Cells(i + 1, "B").Value Then
.Cells(i + 1, "B").ClearContents
End If
If .Cells(i, "A").Value = .Cells(i + 1, "A").Value Then
.Cells(i + 1, "A").ClearContents
End If
Next i

For i = LastRow To 1 Step -1

If .Cells(i, "B").Value2 <> "" Then

.Rows(i + 1).Insert
.Cells(i, "C").Resize(, 5).Cut .Cells(i + 1, "C")
End If

If .Cells(i, "A").Value2 <> "" Then

.Rows(i + 1).Insert
.Cells(i, "B").Cut .Cells(i + 1, "B")
End If
Next i
End With
End Sub
[/vba]

[braven]

wow xld, this is going to take some time to digest. At first try it works great! Now to figure out your black magic...

thanks!