Request for help to split data from master to seperate sheets

M

MeaclH

New Member
Joined
Apr 2, 2014
Messages
13
Hi all,

Need some help if possible. I have found several options for a solution but not the perfect one.

Basically I have the attached spreadsheet as my master spreadsheet. I want to simply split that data based on the Captain ID Code. For example the rows containing Captain ID 7108 would be put onto a standalone sheet, the rows containing Captain ID 7042 would be put onto another standalone sheet and so on and so on.

This leading a to a larger project which I think I can manage myself, however if anyone has any ideas on how to use the data to auto populate a template. ie. All of Captain ID 7108's flight details would be placed into a template on a seperate sheet I would be grateful for the help.



Many thanks in advance,

Hayden
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
My mistake I am not sure how to attach the spreadsheet for viewing on here but the column data is as follows

FlightRegoSTDFrom ToCaptainPax
758VHVNH2/04 16:05PERSYD7108110
759VHVNO3/04 09:55SYDPER7108112
211VHVND2/04 19:30SYDMEL704255

<colgroup><col span="2"><col><col span="4"></colgroup><tbody>
</tbody>


Cheers.

Hayden
 
Upvote 0
MeaclH said:
My mistake I am not sure how to attach the spreadsheet for viewing on here but the column data is as follows

FlightRegoSTDFromToCaptainPax
758VHVNH2/04 16:05PERSYD7108110
759VHVNO3/04 09:55SYDPER7108112
211VHVND2/04 19:30SYDMEL704255

<tbody>
</tbody>


Cheers.

Hayden
Click to expand...
here's a code I wrote a while ago and had stored in the attic. I think it's been posted somewhere on this forum some time ago.

Maybe it'll do something like you are after.

Change the Const cl& = 3 near the top to whatever number column your Captain ID's are in
Code: 
Sub code_as_modified()

Const cl& = 3
Dim lr&, lc&, s&, i&
Dim hdr, q As String, d As Object, sh As Worksheet
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
For Each sh In Worksheets
    d(sh.Name) = 1
Next sh
lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
s = 2
Set ash = ActiveSheet

With Sheets.Add(after:=ash)
    ash.Cells(1).Resize(lr, lc).Copy .Cells(1)
    hdr = .Cells(1).Resize(, lc)
    .Cells(1).Resize(lr, lc).Sort .Cells(cl), Header:=xlYes
    a = .Cells(cl).Resize(lr + 1)
    For i = 2 To lr
        If a(i, 1) <> a(i + 1, 1) Then
            q = CStr(a(i, 1))
            If Not d(q) = 1 Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = q
            Else
                Sheets(q).UsedRange.ClearContents
            End If
            .Cells(s, 1).Resize(i - s + 1, lc).Copy Sheets(q).Cells(2, 1)
            s = i + 1
            Sheets(q).Cells(1).Resize(, lc) = hdr
        End If
    Next i
Application.DisplayAlerts = False
    .Delete
Application.DisplayAlerts = True
End With

ash.Activate
Application.ScreenUpdating = True


End Sub
 
Upvote 0
mirabeau said:
here's a code I wrote a while ago and had stored in the attic. I think it's been posted somewhere on this forum some time ago.

Maybe it'll do something like you are after.

Change the Const cl& = 3 near the top to whatever number column your Captain ID's are in
Code: 
Sub code_as_modified()

Const cl& = 3
Dim lr&, lc&, s&, i&
Dim hdr, q As String, d As Object, sh As Worksheet
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
For Each sh In Worksheets
    d(sh.Name) = 1
Next sh
lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
s = 2
Set ash = ActiveSheet

With Sheets.Add(after:=ash)
    ash.Cells(1).Resize(lr, lc).Copy .Cells(1)
    hdr = .Cells(1).Resize(, lc)
    .Cells(1).Resize(lr, lc).Sort .Cells(cl), Header:=xlYes
    a = .Cells(cl).Resize(lr + 1)
    For i = 2 To lr
        If a(i, 1) <> a(i + 1, 1) Then
            q = CStr(a(i, 1))
            If Not d(q) = 1 Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = q
            Else
                Sheets(q).UsedRange.ClearContents
            End If
            .Cells(s, 1).Resize(i - s + 1, lc).Copy Sheets(q).Cells(2, 1)
            s = i + 1
            Sheets(q).Cells(1).Resize(, lc) = hdr
        End If
    Next i
Application.DisplayAlerts = False
    .Delete
Application.DisplayAlerts = True
End With

ash.Activate
Application.ScreenUpdating = True


End Sub
Click to expand...



Hi Mirabeau,

Thanks for your reply. One thing if you can help me with, instead of naming the sheet the Captains ID- How can I make it just so it names it Sheet 1, Sheet 2, Sheet 3 etc etc


Thanks
Hayden
 
Upvote 0
MeaclH said:
Hi Mirabeau,

Thanks for your reply. One thing if you can help me with, instead of naming the sheet the Captains ID- How can I make it just so it names it Sheet 1, Sheet 2, Sheet 3 etc etc


Thanks
Hayden
Click to expand...
Make the modifications in red, as below
Rich (BB code): 
Sub code_as_modified2()

Const cl& = 3
Dim lr&, lc&, s&, i&, w&
Dim hdr, q As String, d As Object, sh As Worksheet
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
For Each sh In Worksheets
    d(sh.Name) = 1
Next sh
lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
s = 2
Set ash = ActiveSheet

With Sheets.Add(after:=ash)
    ash.Cells(1).Resize(lr, lc).Copy .Cells(1)
    hdr = .Cells(1).Resize(, lc)
    .Cells(1).Resize(lr, lc).Sort .Cells(cl), Header:=xlYes
    a = .Cells(cl).Resize(lr + 1)
    For i = 2 To lr
        If a(i, 1) <> a(i + 1, 1) Then
            'q = CStr(a(i, 1))
            w = w + 1
            q = "Sheet " & w
            If Not d(q) = 1 Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = q
            Else
                Sheets(q).UsedRange.ClearContents
            End If
            .Cells(s, 1).Resize(i - s + 1, lc).Copy Sheets(q).Cells(2, 1)
            s = i + 1
            Sheets(q).Cells(1).Resize(, lc) = hdr
        End If
    Next i
Application.DisplayAlerts = False
    .Delete
Application.DisplayAlerts = True
End With

ash.Activate
Application.ScreenUpdating = True


End Sub
 
Upvote 0
mirabeau said:
Make the modifications in red, as below
Rich (BB code): 
Sub code_as_modified2()

Const cl& = 3
Dim lr&, lc&, s&, i&, w&
Dim hdr, q As String, d As Object, sh As Worksheet
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
For Each sh In Worksheets
    d(sh.Name) = 1
Next sh
lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
s = 2
Set ash = ActiveSheet

With Sheets.Add(after:=ash)
    ash.Cells(1).Resize(lr, lc).Copy .Cells(1)
    hdr = .Cells(1).Resize(, lc)
    .Cells(1).Resize(lr, lc).Sort .Cells(cl), Header:=xlYes
    a = .Cells(cl).Resize(lr + 1)
    For i = 2 To lr
        If a(i, 1) <> a(i + 1, 1) Then
            'q = CStr(a(i, 1))
            w = w + 1
            q = "Sheet " & w
            If Not d(q) = 1 Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = q
            Else
                Sheets(q).UsedRange.ClearContents
            End If
            .Cells(s, 1).Resize(i - s + 1, lc).Copy Sheets(q).Cells(2, 1)
            s = i + 1
            Sheets(q).Cells(1).Resize(, lc) = hdr
        End If
    Next i
Application.DisplayAlerts = False
    .Delete
Application.DisplayAlerts = True
End With

ash.Activate
Application.ScreenUpdating = True


End Sub
Click to expand...


My mistake - I have figured out why. ** Thanks so much Mirabeau**

Hi Mirabeau,

Sorry to be a pain - It is now splitting every row onto a seperate sheet. Rather than keeping the data relevant to each Captain ID together on the same new sheet.

Really appreciate the continued help.


Regards,

Hayden
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Macro that splits a Master data workbook into multiple workbooks
Replies
0
Views
566
Bobstar
B
D
  • Question
Pull cell data from multiple sheets into a list on a master sheet
Replies
2
Views
607
Sanjeev1976
Sanjeev1976
D
  • Solved
Automation of Tabs
2
Replies
10
Views
579
kevin9999
K
S
  • Question
VBA Macro for: Copying unique variables entered on one sheet automatically on to new worksheet?
Replies
3
Views
485
Georgiboy
Georgiboy
M
  • Question
VBA Create New Sheet, named from data in selected cell, and other functions
Replies
0
Views
310
MeaclH
M

Forum statistics

Threads
1,214,641
Messages
6,120,688
Members
448,978
Latest member
rrauni

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