Sorting Data on to sub worksheet by date

[Newbienew]

So I am looking to sort data on one specific sheet to other sheets by the date. I watch a video on it on youtube but it seemed to be a lot. This was the title of the video "Spreadsheets: How to Sort Data Onto Sub Sheets". I was hoping there might be a better way to do this or achieve this goal. I will have a total of 12 months and one sheet for historic data. I thank you for your help in advance[/COLOR]

 

[Logit]

.
Amazon, as far as I know, still offers a free cloud service.

Another is DropBox.com

There are others as well: Gmail has a cloud service.

You can Google 'free cloud service' to see a long list of what is available.

 

[Newbienew]

And do i just added it here. Like a shared link or so?

 

[Logit]

.
Use this version of the macros :

Option Explicit


Sub CreateSheets()


    Dim Cell    As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet


        Set RngBeg = Worksheets("Sheet1").Range("D2")
        Set RngEnd = Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp)


        ' Exit if the list is empty.
        If RngEnd.Row < RngBeg.Row Then Exit Sub
Application.ScreenUpdating = False
        For Each Cell In Worksheets("Sheet1").Range(RngBeg, RngEnd)
            On Error Resume Next
                ' No error means the worksheet exists.
                Set Wks = Worksheets(Format(Cell.Value, "[$-409]mmm;@"))


                ' Add a new worksheet and name it.
                If Err <> 0 Then
                    Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    Wks.Name = Format(Cell.Value, "[$-409]mmm;@")
                End If
            On Error GoTo 0
        Next Cell
Application.ScreenUpdating = True


MakeHeaders
End Sub


Sub MakeHeaders()
Dim srcSheet As String
Dim dst As Integer
srcSheet = "Sheet1"
Application.ScreenUpdating = False
For dst = 1 To Sheets.Count
    If Sheets(dst).Name <> srcSheet Then
    Sheets(srcSheet).Rows("1:1").Copy
    Sheets(dst).Activate
    Sheets(dst).Range("A1").PasteSpecial xlPasteValues
    'ActiveSheet.PasteSpecial xlPasteValues
    Sheets(dst).Range("A1").Select
    End If
Next
Application.ScreenUpdating = True
CopyData
End Sub


Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
On Error Resume Next
Lastrow = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row
Dim ans As String
Dim ans2 As String


NoVisi


    For i = 2 To Lastrow
    ans = Sheets("Sheet1").Cells(i, 4).Value
    ans2 = Format(ans, "[$-409]mmm;@")
        Sheets("Sheet1").Rows(i).Copy Sheets(ans2).Rows(Sheets(ans2).Cells(Rows.Count, "A").End(xlUp).Row + 1)
    Next
    
Visi


Application.ScreenUpdating = True


Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select


Exit Sub


Application.ScreenUpdating = True


End Sub


Sub NoVisi()
Dim CommandButton1 As Object


CommandButton1.Visible = False


End Sub


Sub Visi()
Dim CommandButton1 As Object


CommandButton1.Visible = True
End Sub

 

[Logit]

.
I just posted a revised version of the code to accomplish what you were seeking.

When posting a link, when you respond, in the REPLY TO THREAD menu there is an icon .. looks like a GLOBE with a chain link. Click that and paste the
URL in the small box that appears.

 

[Newbienew]

With your new revision how do I implement it. I ask cause i believe i have been doing it wrong




http://www.dropbox.com/s/0rpsaz83o1hx1kb/TESTTED.xlsx?dl=0

 

[Newbienew]

With your new revision how do I implement it. I ask cause i believe i have been doing it wrong

I sorted it a bit just to give you an idea. As you see everytime a new entry is made with that date it would transfer to month sheet.

Side question, if the comments are updated on the main sheet will that update on month sheets.




http://www.dropbox.com/s/0rpsaz83o1hx1kb/TESTTED.xlsx?dl=0

 

[Logit]

.
Download workbook : https://www.amazon.com/clouddrive/share/uR3nSGMl2fETM53wn1TyAEcqCEml1Fvp0iTojQ1a8Ib

Option Explicit


Sub CreateSheets()




    Dim Cell    As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet




        Set RngBeg = Worksheets("Main").Range("D2")
        Set RngEnd = Worksheets("Main").Cells(Rows.Count, "D").End(xlUp)




        ' Exit if the list is empty.
        If RngEnd.Row < RngBeg.Row Then Exit Sub
Application.ScreenUpdating = False
        For Each Cell In Worksheets("Main").Range(RngBeg, RngEnd)
            On Error Resume Next
                ' No error means the worksheet exists.
                Set Wks = Worksheets(Format(Cell.Value, "[$-409]mmm;@"))




                ' Add a new worksheet and name it.
                If Err <> 0 Then
                    Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                    Wks.Name = Format(Cell.Value, "[$-409]mmm;@")
                End If
            On Error GoTo 0
        Next Cell
Application.ScreenUpdating = True




MakeHeaders
End Sub




Sub MakeHeaders()
Dim srcSheet As String
Dim dst As Integer
srcSheet = "Main"
Application.ScreenUpdating = False
For dst = 1 To Sheets.Count
    If Sheets(dst).Name <> srcSheet Then
    Sheets(srcSheet).Rows("1:1").Copy
    Sheets(dst).Activate
    Sheets(dst).Range("A1").PasteSpecial xlPasteValues
    'ActiveSheet.PasteSpecial xlPasteValues
    Sheets(dst).Range("A1").Select
    End If
    Columns("A:Q").EntireColumn.AutoFit
Next


Application.ScreenUpdating = True
CopyData
End Sub




Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
On Error Resume Next
Lastrow = Sheets("Main").Cells(Rows.Count, "D").End(xlUp).Row
Dim ans As String
Dim ans2 As String




NoVisi




    For i = 2 To Lastrow
    ans = Sheets("Main").Cells(i, 4).Value
    ans2 = Format(ans, "[$-409]mmm;@")
        Sheets("Main").Rows(i).Copy Sheets(ans2).Rows(Sheets(ans2).Cells(Rows.Count, "A").End(xlUp).Row + 1)
    Next
    
Visi




Application.ScreenUpdating = True




Sheets("Main").Activate
Sheets("Main").Range("A1").Select




Exit Sub




Application.ScreenUpdating = True




End Sub




Sub NoVisi()
Dim CommandButton1 As Object




CommandButton1.Visible = False




End Sub




Sub Visi()
Dim CommandButton1 As Object




CommandButton1.Visible = True
End Sub

 

[Newbienew]

First, thank you so much This is greaaatt. I know i am asking a lot as well as a lot of questions this is foreign to me Sorry. But thank you so much for your aid.

I was wondering if there a way for me to stop it from creating duplication every time the button is clicked
If I update an entry will it be a new entry in the month or will it overwrite what was already there.
How do i stop it from creating blank sheets
Is there a way to copy over the format and filters from the first row, and if i filter and click the button will it only sort the what is sorted

I attempted to try and learn how to do the code myself as another project has just been passed to me. I have to make a historic page/gain page. Basically if we gain some one it needs to be on a historic page. I have attached the in the workbook I believe the code Create sheetss with two ss is the one i was attempting to test out.

Above all of this you are awesome as I didn't know if this all was even possible when I first asked. I am humbly grateful for all your efforts, time, and help.

https://www.dropbox.com/s/r053sub8pyyidcm/TESTTED.xlsm?dl=0

 

[Logit]

.
We can change the macro to first delete all sheets EXCEPT the MAIN sheet. Then the existing macros will take over and recreate all the sheets with
the data separate by date as it is doing now.

The advantage to this approach is:

- no duplication of sheets
- no duplication of data
- the added sheets will always have the most current data displayed without duplications

Is this something that would work in your scenario ?

 

[Newbienew]

This does sound like something that would work, yes. Now, I have a question though, if there is not date will it create a blank sheet? I am asking as the sheet was modified in the date column, I have so far ???, Unknown, and a few blanks.

I am currently waiting for the last changes before the workbook gets back to my queue just incase added information may have changed of shift a column or two.


Thank you very much for your help.