Report

Extracting multiple date from master sheet to new sheets [Solved]

Ask a question alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Latest answer on Dec 21, 2015 09:13AM
Hi I run a sports tipping site and I want to extract data from my master sheet to make other sheets. I.e in sports cloumn I have multiple sports and want to send the data for each sport to a seperate sheet for each. I am not that PC Savvy so need all the help I can get as the main spreadsheet I am using is from someone else and I just need to add more to it. I came across this site and thought it looked great and I would appreciate any help you can give.. I have enclosed a picture of what my main sheet looks like .
See more 
Helpful
+7
moins plus
Hello Alan,

Lets start by trying the following code tweaked a little to suit your needs (I think!):_

Sub CreateSheetsCopyData()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

        Dim MySheet As String
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet
       
LR = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("B2:B" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
      
Sheet1.Select

For Each cell In Range("B2:B" & LR)
    MySheet = cell.Value
    cell.EntireRow.Copy Sheets(MySheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Next cell
   
For Each ws In ActiveWorkbook.Sheets
    If ws.Range("A1") = "" Then ws.Delete
Next ws
   
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub


The code searches Column B for the type of sport (reserve this column just for the sport type. If you need to place the league beside the sport, then insert a new column for the league alone). It then creates a new sheet for each sport and transfers the data for each sport to its individual sheet.

To implement the code:-

- At the top of your work sheet, click on the Developer tab.
- Over to the far left, click on Visual Basics.
- On the next screen that appears, click on "Insert" and then select Module.
- The grey screen turns white. In this white field, paste the above code.
- Go back to your work sheet and the Developer tab.
- Over to the far left, click on "Macros".
- A little "Macro" window will appear. In the larger field, you will see the name of the macro (in this case, CreateSheetsCopyData). Select this name and then click on "Run".

You should then see the code execute and do its thing.
We could have some niggling problems as I'm not sure as to how your data set looks, so it would be best if you could upload a sample of your work book for us to have a look at. You can upload a sample by using a free file sharing site such as DropBox, ge.tt or SpeedyShare and then posting back here with the link to your work book. Be careful with any sensitve data in your sample.

Let us know how it goes.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 12, 2015 06:04AM
Great cheers for that..I shall be working on it again on Monday as I am about to go away for a couple of days but will let you know how if goes when done... Many thanks for all your help it is much appreciated...Wish I had found this site earlier lol
Reply
vcoolio 785Posts Thursday July 24, 2014Registration date ModeratorStatus September 19, 2016 Last seen - Dec 12, 2015 06:28AM
No worries Alan.

Have a good one!

Cheerio,
vcoolio.
Reply
Add comment
Helpful
+3
moins plus
Hello Alan,

Have a look at the following current thread by another Poster:-

http://ccm.net/forum/affich-861487-how-to-separate-the-worksheet-based-on-data

I'm pretty sure that the code I supplied should do the job for you also, with a couple of tweaks.

Let us know what you think.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 12, 2015 05:17AM
Many thanks for your quick response..You may have to help me out here as i'm not that good with all this.... It looks like it could do the job but where do I write the code and do I write it as is...told you I wasn't very good at this being old and a newbie lol... Much appreciated
Reply
Add comment
Helpful
+2
moins plus
Hello Alan,

Sorry to be a pain but although I can now access the file, Google will not let me modify it.

Google sheets don't have VBA capability (plus I don't have any experience with Google sheets) so could you please convert the file to a M/Soft .xlsx type file and then repost with a DropBox link. To do this, I believe you need to click on the File tab at the top of the Google sheet, select "Download As" and then select Microsoft.xlsx type. It should then convert to an Excel file.

Your file is very large so, if possible, just copy/convert the "Bets" sheet as this is the sheet that we need to deal with.

Thanks Alan.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 16, 2015 07:21AM
Hi Vcoolio

Here is the link you requested, but if I remember correctly when I have tried to save in google with other sheets that use macros they don't save right but it could just be me as you know i'm not to savvy on all this.. I really do appreciate all that you have done and doing many thanks.

https://www.dropbox.com/s/imub9mbr1wrrfs1/copy%20of%20google%20sheets%20betting%20tracker%20v2.20%20basic%20%281%29.xlsx?dl=0
Reply
Add comment
Helpful
+2
moins plus
Hello Alan,

Using your last sample work book, I have it working OK using the same code as in post no. 13 above but with an additional Application turn off/on as follows:-

Sub CreateSheetsTransferData()

Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False

        Dim MySheet As String
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet
       
LR = Range("C" & Rows.Count).End(xlUp).Row

For Each c In Range("C11:C" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
  
Sheets("Bets").Select
  
For Each cell In Range("C11:C" & LR)
    MySheet = cell.Value
    cell.EntireRow.Copy
    Sheets(MySheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Bets").Range("A9:W9").Copy Sheets(MySheet).Range("A1")
    Sheets(MySheet).Range("A1:W1").Columns.WrapText = False
    Sheets(MySheet).Columns.AutoFit
    
Next cell

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
MsgBox "Sheets created and data transfer completed!", vbExclamation, "Status"
Sheets("Bets").Select

End Sub


There are a mass of formulae in the work book doing many calculations which slow and disrupt VBA execution so, by using Application.Calculation = xlCalculationManual at the begining of the code, all automatic calculations are turned off and by using Application.Calculation = xlCalculationAutomatic at the end of the code, automatic calculations are enabled again.

Hopefully.............

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 21, 2015 04:21AM
Hi Vccolio

I don't know whats going on but when I ran the above it just added the sheets and still don't add to sheets after I've added to master sheet.. I had to put the date in manually on the American Football sheet even though I have set the date format on the master sheet..Maybe I shall have to do the extra sheets manually but as you can propbably guess this does involve a lot of extra work...Thanks again for all your help much apprieciated
Reply
Add comment
Helpful
+1
moins plus
Hello Alan,

In the meantime, I've done a quick mock-up for you here:-

https://www.dropbox.com/s/h82p2d7moog8fhu/Alan180%28create%20sheets%20%26%20copy%20data%29.xlsm?dl=0

I've tweaked the code a bit further:-

Sub CreateSheetsCopyData()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

        Dim MySheet As String
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet
       
LR = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("B2:B" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
      
Sheet1.Select

For Each cell In Range("B1:B" & LR)
    MySheet = cell.Value
    cell.EntireRow.Copy Sheets(MySheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Range("A1:I1").Copy Sheets(MySheet).Range("A1")
    Sheets(MySheet).Columns.AutoFit
Next cell
   
For Each ws In ActiveWorkbook.Sheets
    If ws.Range("A1") = "" Then ws.Delete
Next ws

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub


See what you think.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 15, 2015 11:35AM
Hi Vcoolio ..I replied to the previous e mails with the info you requested but here is the link to the sheet https://docs.google.com/spreadsheets/d/18vcHyG17yZkoOYkhxXe1Q4LVHT3URc1qGMO2M3sZ4QI/edit#gid=1540405304

Many Thanks for your help so far..Much Appreciated and it's a great site
Reply
Add comment
Helpful
+1
moins plus
Hello Alan,

You: #confused.com...
Me: #bewildered.com...

I suppose that you have checked my last DropBox link and seen that it all works just fine.

Anyway, in a separate module, place the following function:-

Function WorksheetExists(ByVal WorksheetName As String) As Boolean
 Dim Sht As Worksheet

For Each Sht In ActiveWorkbook.Worksheets 'ThisWorkbook.Worksheets
 If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
 WorksheetExists = True
 Exit Function
 End If
 Next Sht
 WorksheetExists = False
 End Function


In the code from post # 13 above, change this part of the code:-

For Each c In Range("C11:C" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c


to

For Each c In Range("C11:C" & LR)
        Set ws = Nothing
        On Error Resume Next
        If Not WorksheetExists(c.Value) Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c


and change line no. 30 to this:-

Sheets("Bets").Range("A9:W9").Copy Sheets(MySheet).Range("A1")


Let us know if this makes any difference.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 20, 2015 05:30AM
Hi Vcoolio

still no joy here is the link for the sheet i'm using so you can check that i am doing things right

https://www.dropbox.com/s/argzo2gdo69kfzv/simplythebets%20result%20sheets%202016%20beta.xlsm?dl=0
Reply
Add comment
Helpful
+1
moins plus
Hello Alan,

Following is a link to the latest work book sample you supplied, with code implemented. You'll see that it works just fine.

https://www.dropbox.com/s/690lvsyapgt78ou/Alan180%28create%20sheets%20%26%20copy%20data%29%2C3.xlsm?dl=0

I cannot see any reason why it won't work for you now.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 21, 2015 06:42AM
Hi Vcoolio

I downloaded the file, then enabled content, then allowed macros, then went into macros and clicked run this brought up all sheets and data that was on the mastersheet so far so good..... I then added data to master sheet but still it hasn't gone onto other sheets...is there something I am missing doing once I've added to master sheet..if I run the macros again it just brings up another row of what is already there plus the new data...anyway of getting rid of previous when re running
Reply
Add comment
Helpful
+1
moins plus
Hello Alan,

I've just spent quite an amount of time adding new rows of data in the "Bets" sheet (Date, Sport a couple of other columns with fake data) and its working perfectly. I repeated the process many, many times with no problems. Following is the code again adjusted to refresh each sheet so that you won't have duplication:-


Sub CreateSheetsTransferData()

Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False

        Dim MySheet As String
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet
        Dim ar As Variant
    
LR = Range("C" & Rows.Count).End(xlUp).Row

For Each Sht In Worksheets
        If Sht.Name <> "Bets" And Sht.Name <> "Settings" And Sht.Name <> "Deposits" And Sht.Name <> "Intro" And Sht.Name <> "Available Funds" _
        And Sht.Name <> "Performance Summary" And Sht.Name <> "Tipper Analysis" And Sht.Name <> "Closing Odds Analysis" And Sht.Name <> "Closing Line Analysis" And Sht.Name <> "Performance Graph" Then
        Sht.UsedRange.Offset(1).ClearContents
        End If
Next Sht

For Each c In Range("C11:C" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
  
Sheets("Bets").Select
  
For Each cell In Range("C11:C" & LR)
    MySheet = cell.Value
    cell.EntireRow.Copy
    Sheets(MySheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Sheets("Bets").Range("A9:W9").Copy Sheets(MySheet).Range("A1")
    Sheets(MySheet).Range("A1:W1").Columns.WrapText = False
    Sheets(MySheet).Columns.AutoFit
    Sheets(MySheet).Columns(1).NumberFormat = "dd/mm/yyyy"
Next cell

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
MsgBox "Sheets created and data transfer completed!", vbExclamation, "Status"
Sheets("Bets").Select

End Sub


Here is the work book with the adjusted code:-

https://www.dropbox.com/s/690lvsyapgt78ou/Alan180%28create%20sheets%20%26%20copy%20data%29%2C3.xlsm?dl=0

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 21, 2015 08:23AM
Hi Vcoolio

YESSSSSSSSSSSSSSSSSSSSSSSSSSSSSS...at last I have it working perfectly OMG so sorry I was such a pain but many many thanks for all of your help. Have a Merry Xmas and a Happy New year to yourself and family and all at CCM....I can't thank you enough cheers
Reply
vcoolio 785Posts Thursday July 24, 2014Registration date ModeratorStatus September 19, 2016 Last seen - Dec 21, 2015 09:00AM
Hello Alan,

You're welcome. Glad that I could help. BTW, fellow contributor RayH kept an eye on this thread and offered some very helpful hints in the back ground. Please raise your glass to Ray also.

Merry Xmas and a Happy New Year to you and yours also.

Cheerio,
vcoolio.
Reply
Add comment
Helpful
+0
moins plus
Hello Alan,

Google won't let me access the data even though I have an account and have requested your permission.

To speed things up, could you please upload your work book to DropBox and post back with the link.

Thank you.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 16, 2015 02:01AM
Hi Vcoolio Google asked me to give you permission to edit which I have now done so hopefully you can now access it.. Once again many thanks
Reply
Add comment
Helpful
+0
moins plus
Hello Alan,

The following code should do the job for you:-

Sub CreateSheetsTransferData()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

        Dim MySheet As String
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet
       
LR = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("C11:C" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
  
Sheet4.Select
  
For Each cell In Range("C11:C" & LR)
    MySheet = cell.Value
    cell.EntireRow.Copy
    Sheets(MySheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Range("A9:W9").Copy Sheets(MySheet).Range("A1")
    Sheets(MySheet).Range("A1:W1").Columns.WrapText = False
    Sheets(MySheet).Columns.AutoFit
    
Next cell

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Sheets created and data transfer completed!", vbExclamation, "Status"
Sheet4.Select

End Sub


Please note though that you won't be able to implement the code into a Google spread sheet. You will need to convert the whole file to an xlsx type file, implement the code and save it as a type xlsm file.

Following is a link to your work book (converted) with the code implemented. Click on the "Cretae Sheets/Transfer" button to see it work.

https://www.dropbox.com/s/w2cd0n1qjlnvqbg/Alan180%28create%20sheets%20%26%20copy%20data%29%2C2.xlsm?dl=0

Converting your file to xlsx is the only way to make this work as formulae alone will not be able to do what is required.

Good luck!

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 17, 2015 06:12AM
Hi Vcoolio

I have added the code and all seems to be working fine... Many thanks for spending so much time on this for me. If there are any problems occur you will hear from me again, unless by some miracle I can figure it out for myself lol...

Merry Xmas and Happy New Year to you and all at CCM.

GREAT SITE, GREAT HELP, FIRST CLASS SERVICE.
Reply
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 17, 2015 06:23AM
HI Vcoolio

Sorry I spoke too soon...When I add extra lines on main sheet they are not going onto other sheets
Reply
vcoolio 785Posts Thursday July 24, 2014Registration date ModeratorStatus September 19, 2016 Last seen - Dec 18, 2015 03:57AM
Hello Alan,

Ensure that there is a date in Column A. I noticed this little quirk the other day and I'm not sure why. As I said in an earlier post, I'm not too sure about Google sheets or how it affects proper execution of VBA codes even when converted to xlsx type files.

Cheerio,
vcoolio.
Reply
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 18, 2015 04:14AM
Hi Vccolio

I have a date in column a on master sheet, but on most sheets it comes through as a number on the new sheets and when I add to the master sheet they don't appear on the other sheets....I have a copy of the whole workbook in excel so I will add the code to that and see what happens...Thanks again.
Reply
vcoolio 785Posts Thursday July 24, 2014Registration date ModeratorStatus September 19, 2016 Last seen - Dec 18, 2015 04:27AM
Hello Alan,

I have a date in column a on master sheet, but on most sheets it comes through as a number on the new sheets


You'll need to format the date columns to your required date format.

Cheerio,
vcoolio.
Reply
Add comment
Helpful
+0
moins plus
Hello Alan,

A slight change to the code should do it.

In the code from post no. 13 above, change line 12 to:-

LR = Range("C" & Rows.Count).End(xlUp).Row


Following is the updated link to the sample file:-

https://www.dropbox.com/s/w2cd0n1qjlnvqbg/Alan180%28create%20sheets%20%26%20copy%20data%29%2C2.xlsm?dl=0

Let us know how it goes.

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 19, 2015 06:07AM
Hi Vcoolio

I changed that code and I now have all the sheets tabs at the bottom as is normal, but when I add something to the master sheet it still don't save to the other sheets apart from that all is good...Once again many thanks for your help
Reply
Add comment
Helpful
+0
moins plus
Hello Alan,

I'm not sure why that is because, as you can see from the sample file in my last post, the code does all that it needs to do and the sample is a copy of your actual work book. Are you receiving any error messages?

When you add more rows of data in the master sheet, you need to still click on the button to transfer the new data to its individual sheet. The code is not a Worksheet_Change event (which means that an event will happen once data is entered into a cell/row and you move onto the next cell/row to add more data).

Cheerio,
vcoolio.
alan180 17Posts Friday December 11, 2015Registration date December 21, 2015 Last seen - Dec 19, 2015 07:37AM
Hi Vcoolio

Rather than using that google sheet (as it didn't take macro's) I am using an excel version of the same workbook.... I changed the line in basics and then went into macro and ran it... It then brought all the new sheet tabs down the bottom as normal...
I then added some data to the master sheet, but it didn't save in real time or after saving master sheet...No error messages.
I even went back into basics and ran it again but it just came up with more sheets opening down the bottom but even then the new data wasn't there.. #confused.com...
Reply
Add comment
Helpful
+0
moins plus
Hi RayH

I apologize for not crediting you with your help, I didn't realize you was also involved. May I now take this opportunity to thank you for your input and your your help in sorting my issue out. Hope you and the family have a great Xmas and a Happy New Year.
Add comment

Members get more answers than anonymous users.

Being a member gives you detailed monitoring of your requests.

Being a member gives you additional options.

Not a member yet?

sign-up, it takes less than a minute and it's free!