Need help :-(

bboy

New Member
Joined
Mar 28, 2011
Messages
28
Hey,

I need help splitting a list like the below in to a new excel work book. So all players from room 1 are saved in to an excel called room1 and so on. All the feilds must be present.

<TABLE style="WIDTH: 206pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=273><COLGROUP><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 2560" width=70><COL style="WIDTH: 38pt; mso-width-source: userset; mso-width-alt: 1828" width=50><COL style="WIDTH: 67pt; mso-width-source: userset; mso-width-alt: 3254" width=89><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20 width=64>Nickname</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" class=xl63 width=70>Username</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; WIDTH: 38pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" width=50>room</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; WIDTH: 67pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" width=89>Amount Won</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player1</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player1</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room1</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player2</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player2</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room1</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player3</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player3</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room1</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player3</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player3</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room2</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player4</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player4</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room2</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player5</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player5</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room2</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player6</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player6</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room3</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player7</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player7</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room3</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" height=20>Player8</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Player8</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2">Room3</TD><TD style="BORDER-BOTTOM: #e2e2e2; BORDER-LEFT: #e2e2e2; BACKGROUND-COLOR: transparent; BORDER-TOP: #e2e2e2; BORDER-RIGHT: #e2e2e2" align=right>3</TD></TR></TBODY></TABLE>

I kind of got one to work but i dont really know what i am doing and it splits the list so many times by each row.

So just to re cap. The heads of Nickname username Room and amount won must stay then the players split by room. Here is what i have all ready. Can any one help me?

Sub Test()
Dim Sh As Worksheet
Dim rng As Range
Dim c As Range
Dim List As New Collection
Dim Item As Variant
Dim ShNew As Worksheet
Dim FName As String
Application.ScreenUpdating = False
' *** Change Sheet name to suit ***
Set Sh = Worksheets("Sheet1")
Set rng = Sh.Range("A2:D" & Sh.Range("D65536").End(xlUp).Row)
On Error Resume Next
For Each c In rng
List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set rng = Sh.Range("A1:I" & Sh.Range("A65536").End(xlUp).Row)
For Each Item In List
Set ShNew = Worksheets.Add
ShNew.Name = Item
rng.AutoFilter Field:=3, Criteria1:=Item
Sh.Cells.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A2:D2")
ShNew.Copy
ActiveSheet.Rows(1).Delete
FName = ThisWorkbook.Path & "\" & Item & ".csv"
ActiveWorkbook.SaveAs Filename:=FName
ActiveWorkbook.Close SaveChanges:=False
rng.AutoFilter
Next Item
Sh.Activate
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

bboy

New Member
Joined
Mar 28, 2011
Messages
28
Hey it's not some thing I can really down loadon to a work computer
 

bboy

New Member
Joined
Mar 28, 2011
Messages
28

ADVERTISEMENT

Hey thanks for that.

Just got a small problem.

I took the below from your sheet but when i try and open the new sheets that were saved it gives me an error. Do you know how to get rid of it? Plus id like it to save these as a csv file.

Error

"The file you are trying to open, 'Room1.csv' is in a different format than specified by the file extenstion. Verify that the file is not corrupted and is from a trusted source before opening this file."

Macro im using

Sub Splitlists()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
On Error Resume Next
Set r = Application.InputBox("Click in the column to extract by", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
Master = .Name
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To LastRow
If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Cells(iStart, iCol).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
If MsgBox("Do you want to save the separated sheets as workbooks", vbYesNo + vbQuestion) = vbYes Then
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> Master Then
sh.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Prefix & sh.Name & ".Csv"
ActiveWorkbook.Close
End If
Next sh
Application.ScreenUpdating = True
End If
End Sub

Id like to keep this macro as it is just changing the extenstion if possible to it is openable with out error and is also able to open in excel 2003
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

Rich (BB code):
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Prefix & sh.Name & ".Csv", FileFormat:=xlCSV
 

bboy

New Member
Joined
Mar 28, 2011
Messages
28

ADVERTISEMENT

Thats awesome thank you.

Is there any way to just save it with out asking to save changes. As i got 60+ save changes pop ups lol
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

Code:
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Prefix & sh.Name & ".Csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
 

bboy

New Member
Joined
Mar 28, 2011
Messages
28
You are frigging awesome!!!! Thanks so much. I think i owe you some beers!!!
 

bboy

New Member
Joined
Mar 28, 2011
Messages
28
Hey Just one more problem one this.

This file shows as it being saved as a CSV but the saved csv files are only extenstions and not actual CSV (comma delimited) (*.csv) if you know what i mean. Is there another way to save it as a proper csv. The below is what i have now.

Sub Splitlists()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
On Error Resume Next
Set r = Application.InputBox("Click in the column to extract by", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
Master = .Name
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To LastRow
If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Cells(iStart, iCol).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
If MsgBox("Do you want to save the separated sheets as workbooks", vbYesNo + vbQuestion) = vbYes Then
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> Master Then
sh.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Prefix & sh.Name & ".Csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
End If
Next sh
Application.ScreenUpdating = True
End If
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,108,911
Messages
5,525,593
Members
409,653
Latest member
rishir

This Week's Hot Topics

Top