HELP! New to coding-need to split workshhet into multiple by finding a word that ends the data each time

S

suntreemom

New Member
Joined
Dec 18, 2013
Messages
3
Hi. I am not really a coder and this is new to me but I have an extremely large spreadsheet I need to disect into a seperate workbook for each set of data. While browsing on this forum I saw many references for splitting data, but it always split it due to a certain value in a column. My column the value is always unique, but the end of the section I need to split the data ends with [TABLE="width: 72"]
<tbody> [TR]
[TD]>end[/TD]
[/TR]
</tbody> <colgroup> <col></colgroup>[/TABLE]
For instance, I have 4 columns with no headers. Each value is different. It is set up like this:[TABLE="class: grid, width: 500"]
<tbody></tbody>[/TABLE]
[TABLE="class: grid, width: 303, align: center"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]ZAU6101G
[/TD]
[TD]grp=ZAU61[/TD]
[TD]altmin=986[/TD]
[TD]altmax=987[/TD]
[/TR]
[TR]
[TD="align: right"]43.716667
[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG31[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG32[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG22[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG21[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]>end[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ZAU6101H
[/TD]
[TD]grp=ZAU61[/TD]
[TD]altmin=988[/TD]
[TD]altmax=989[/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG31[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG32[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG22[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG21[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]>end[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ZAU6101I
[/TD]
[TD]grp=ZAU61[/TD]
[TD]altmin=990[/TD]
[TD]altmax=991
[/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG31[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG32[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG22[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG21[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]>end[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I need to read the value in each Column A cell (ZAU6101G), this will become the title of my new 'workbook' after being split out. I take all the rows beneath that leading column A cell, until I find a row with >end, and copy over to the new 'workbook' and save the new workbook with the cell A title.

From the table above it would split into three worksheets- titled ZAU6101G, ZAU6101H, and ZAU6101I. The first workshhet would look like this:
[TABLE="class: grid, width: 303, align: center"]
<tbody>[TR]
[TD]ZAU6101G
[/TD]
[TD]grp=ZAU61[/TD]
[TD]altmin=986[/TD]
[TD]altmax=987[/TD]
[/TR]
[TR]
[TD="align: right"]43.716667
[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG31[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG32[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG22[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG21[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]>end[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
The second:
[TABLE="class: grid, width: 303, align: center"]
<tbody>[TR]
[TD]ZAU6101H
[/TD]
[TD]grp=ZAU61[/TD]
[TD]altmin=988[/TD]
[TD]altmax=989[/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG31[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG32[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG22[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG21[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]>end[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
The third:
[TABLE="class: grid, width: 303, align: center"]
<tbody>[TR]
[TD]ZAU6101I
[/TD]
[TD]grp=ZAU61[/TD]
[TD]altmin=990[/TD]
[TD]altmax=991
[/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG31[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.716667[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG32[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.183333[/TD]
[TD]node=CG22[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]43.783333[/TD]
[TD="align: right"]272.116667[/TD]
[TD]node=CG21[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]>end[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I have over 4,000 rows of data to split. Is this possible? Will excel only provide this functionality for so many rows, etc?

Thank you to anyone who can help!! I do not even know how to set up a VB script in excel so please explain like a book for dummies :(

Suntreemom
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
try this macro, change the file path of where you want the new workbooks to save

Code: 
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 18/12/2013 by Abductee
'

'
Dim WB_name, TheLen
    
    Range("A1").Select
On Error GoTo endloop
Do Until ActiveCell.Value = ""

    Columns("A:A").Select
    Selection.Find(What:=">end", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    
TheLen = ActiveCell.Row

    Range("A1:D" & TheLen).Select

    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("A1").Select
    WB_name = ActiveCell.Value
    ChDir "C:\Documents and Settings\USER\Desktop" ' change path to where you want to save files
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\USER\Desktop\" & WB_name & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False  ' change path above to where you want to save files
    ActiveWorkbook.Saved = True
    ActiveWindow.Close
    
    Rows("1:" & TheLen).Select
    Selection.Delete Shift:=xlUp

TheLen = 1
Range("A" & TheLen).Select

Loop
endloop:
End Sub

o
\__/\o
(Oo}
(=-) .===o- ~Z~A~P~
/'''''''\/U'
l l \_/
\\__)
E''''|
| ||
| || The
(__\\ Abductee
 
Upvote 0
abductee said:
try this macro, change the file path of where you want the new workbooks to save

Code: 
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 18/12/2013 by Abductee
'

'
Dim WB_name, TheLen
    
    Range("A1").Select
On Error GoTo endloop
Do Until ActiveCell.Value = ""

    Columns("A:A").Select
    Selection.Find(What:=">end", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    
TheLen = ActiveCell.Row

    Range("A1:D" & TheLen).Select

    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("A1").Select
    WB_name = ActiveCell.Value
    ChDir "C:\Documents and Settings\USER\Desktop" ' change path to where you want to save files
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\USER\Desktop\" & WB_name & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False  ' change path above to where you want to save files
    ActiveWorkbook.Saved = True
    ActiveWindow.Close
    
    Rows("1:" & TheLen).Select
    Selection.Delete Shift:=xlUp

TheLen = 1
Range("A" & TheLen).Select

Loop
endloop:
End Sub

o
\__/\o
(Oo}
(=-) .===o- ~Z~A~P~
/'''''''\/U'
l l \_/
\\__)
E''''|
| ||
| || The
(__\\ Abductee
Click to expand...

Hi Abductee!! Thank you for the reply. I tried entering it and changing the path as mentioned. When i try to run this I get results, buit it only takes the first chunk of data and sends it to a new workbook. I need it do this a thousand times.

Can you help explain this to me? My steps for using your code are:
1. opened the developer tab
2. Opened visual basic
3. Selected 'View>Code'
4. Pasted your code all in one sheet
5. Changed the path
6. Saved
7. Clicked 'Run'

Is there a reason it only does to the first >end and makes a new sheet? I need it to loop through the data, maybe delete the transfered data it just moved so it doesnt see it again, or skip it, and keep searching for the next >end until it reaches the bottom row of the worksheet (43,952).

Thank you from the newbie!! Can I put a star by you or grade you somehow to let other users know how awesome you are?

Suntreemom
 
Upvote 0
Hi

It works fine for me and loops through all the >end statements creating multiple workbooks

I'm not sure how well you know vba. Can you comment out the error handler then step though the code using F8 to see where it errors for you?
 
Upvote 0
Thanks again for your help. I stepped into the code and got this far:
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 18/12/2013 by Abductee
'
'
Dim WB_name, TheLen

Range("A1").Select
'On Error GoTo endloop
Do Until ActiveCell.Value = ""
Columns("A:A").Select
Selection.Find(What:=">end", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

TheLen = ActiveCell.Row
Range("A1:D" & TheLen).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste


Then I get a runtime error '1004': Application-defined or object-defined error.

Thanks again :)
Suntreemom
 
Upvote 0
before the ActiveSheet.Paste line add Range("A1").Select

so it looks like this... maybe that will help

Code: 
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 18/12/2013 by Abductee
'

'
Dim WB_name, TheLen
    
    Range("A1").Select
'On Error GoTo endloop
Do Until ActiveCell.Value = ""

    Columns("A:A").Select
    Selection.Find(What:=">end", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    
TheLen = ActiveCell.Row

    Range("A1:D" & TheLen).Select

    Selection.Copy
    Workbooks.Add
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    WB_name = ActiveCell.Value
    ChDir "C:\Documents and Settings\USER\Desktop" ' change path to where you want to save files
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\USER\Desktop\" & WB_name & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False  ' change path above to where you want to save files
    ActiveWorkbook.Saved = True
    ActiveWindow.Close
    
    Rows("1:" & TheLen).Select
    Selection.Delete Shift:=xlUp

TheLen = 1
Range("A" & TheLen).Select

Loop
endloop:
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

earthworm
  • Question Question
Split Data into separate worksheet based on Cell values
Replies
8
Views
590
earthworm
earthworm
tazeo
  • Question Question
Need help with copying worksheets and creating pivot tables/charts in new workbooks using Macro
Replies
0
Views
701
tazeo
tazeo
J
  • Question Question
Need some help with permutation code, convert from one cell to a range
Replies
3
Views
425
johnnyL
J
N
  • Question Question
excel macro to split data into multiple worksheets based on conditions worksheet
Replies
4
Views
4K
Fluff
Fluff
C
  • Question Question
Need Help with VBA Code - Copy data below and above a specific text
Replies
1
Views
861
onlyadrafter
O

Forum statistics

Threads
1,223,228
Messages
6,170,876
Members
452,363
Latest member
merico17

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top