Automatic new date tabs?

Sunshine8790

Board Regular
Joined
Jun 1, 2021
Messages
86
Office Version
  1. 365
Platform
  1. Windows
This is sort of a double question:

I have this workbook, and I need to download the data for the data sheet once a day, and copy and paste over existing data in the Data tab.
I also need the Data to be separated out into separate tabs per individual dates based on the dates in Column A.
How do I create all these tabs, or make excel automatically create them, and get the data to automatically go to the right tab?

Too much data apparently to put all in a mini sheet, but here's some and a screenshot:


DNRDailyLog.xlsm
ABCDEFGHIJKLMNOPQRSTUVWX
1DateWarehouseChannelShip ModePOShipmentBrandCarrierDCK_CMMTIn YardStatusShiftUserDck PODck UnitsDck CaseDck SKUDNRExpected UnitsExpected CaseRcvd UnitsRcvd CaseRcvd SKUPACKING_LIST_NO
26/18/2021GFCDIRECTAIR0003367176102023196ANTGT 1530lp-DCKD_NOT_RCVD1st ShiftLPENAGD1744391574474439000102023196
36/18/2021GFCDIRECTAIR0003367176102023196ANTGT 1530lp-DCKD_NOT_RCVD1st ShiftLPENAGD1744391574474439000102030497
46/18/2021GFCDIRECTAIR0003367176102023196ANTGT 1530lp-DCKD_NOT_RCVD1st ShiftLPENAGD1744391574474439000102030508
56/18/2021GFCDIRECTAIR0003367176102023196ANTGT 1530lp-DCKD_NOT_RCVD1st ShiftLPENAGD1744391574474439000102036420
66/18/2021GFCDIRECTROUTING GUIDE0003390458000086611UONAvm-DCKD_NOT_RCVD1st ShiftJBATISTAGD14714550000102033056
76/20/2021GFCDIRECTOCN0003237155000086625ANNAMHF44300DCKD_NOT_RCVD1st ShiftMHERNA114G13636136360000101954910
86/20/2021GFCDIRECTOCN0003237155000086625ANNAMHF-DCKD_NOT_RCVD1st ShiftMHERNA114G13636136360000101954910
96/22/2021GFCDIRECTROUTING GUIDE0003170877102049644UOSCHNIEDERwb-DCKD_NOT_RCVD2nd ShiftMKEENGD1941194941000102049644
106/22/2021GFCDIRECTROUTING GUIDE0003170877102049644UOSCHNIEDERwb-DCKD_NOT_RCVD2nd ShiftMKEENGD1941194941000011130033673215630
116/22/2021GFCDIRECTROUTING GUIDE0003170877102049644UOSCHNIEDERwb-DCKD_NOT_RCVD2nd ShiftMKEENGD1941194941000-
126/22/2021GFCDIRECTROUTING GUIDE0003301674000086661ANNAMHF-DCKD_NOT_RCVD1st ShiftMHERNA114G16666266660000102020856
136/22/2021GFCDIRECTROUTING GUIDE0003482371102052899UOUPSGRH-DCKD_NOT_RCVD1st ShiftRHUNTER14G12412424241000102052899
146/22/2021GFCDIRECTROUTING GUIDE0003515807102050920UOUPSGRH-DCKD_NOT_RCVD1st ShiftBHOFFMA14G1761176761000102050920
156/23/2021GFCDIRECTROUTING GUIDE0003102405000086703UOUPSwb-DCKD_NOT_RCVD2nd ShiftWBECHTELGD1125512120000102048760
166/23/2021GFCDIRECTROUTING GUIDE0003170877673215630UONA-DCKD_NOT_RCVD1st ShiftCSANTI314G1621194941000102049644
176/23/2021GFCDIRECTROUTING GUIDE0003170877673215630UONA-DCKD_NOT_RCVD1st ShiftCSANTI314G1621194941000011130033673215630
186/23/2021GFCDIRECTROUTING GUIDE0003170877673215630UONA-DCKD_NOT_RCVD1st ShiftCSANTI314G1621194941000-
196/23/2021GFCDIRECTROUTING GUIDE0003170895673295632UONA-DCKD_NOT_RCVD1st ShiftCSANTI314G1621162621000102049668
206/23/2021GFCDIRECTROUTING GUIDE0003170895673295632UONA-DCKD_NOT_RCVD1st ShiftCSANTI314G1621162621000011130033673295632
Data
 

Attachments

  • Dataimage.png
    Dataimage.png
    179.5 KB · Views: 13
You cannot use "/" in the name of your worksheet tabs. They are not valid characters.
Try changing this line:
VBA Code:
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = key
to
VBA Code:
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = Format(key,"m-d-yyyy")
which will instead name the sheets like "9-17-2021".
Did that. Now I'm getting another Run-Time error:

1631891511052.png


1631891459808.png
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
You would need to change the "key" everywhere else in the code to match what I did with the "Format" function, or else the references won't match.
Or set it equal to a variable that does this calculation, and use this variable in all the places you have "key".

If you want help with this, please post your code using the Code tags so we can copy/paste it. Images are not helpful in that case.
See here: How to Post Your VBA Code
 
Upvote 0
I definitely need help. Currently, my code is this:
If someone can help me fix it, I'd much appreciate it.

VBA Code:
Sub Sunshine()

        Dim sht As Worksheet, ws As Worksheet, lr As Long, i As Long
        Dim DtID As Object, key As Variant
    
        Set sht = Sheets("Data")
        Set DtID = CreateObject("Scripting.Dictionary")
        lr = sht.Range("A" & Rows.Count).End(xlUp).Row
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False
        
        For i = 2 To lr
              If Not DtID.Exists(sht.Range("A" & i).Value) Then
              DtID.Add sht.Range("A" & i).Value, 1
              End If
        Next i
        
        For Each key In DtID.keys
              If Not Evaluate("ISREF('" & key & "'!A1)") Then
              Worksheets.Add(after:=Sheets(Sheets.Count)).Name = Format(key, "m-d-yyyy")
        End If
        
        Set ws = Sheets(key)
        ws.UsedRange.Clear
        
        With sht.Range("A1:A" & lr)
              .AutoFilter 1, key
              .Resize(, 24).Copy ws.[A1]
              .AutoFilter
        End With
              ws.Columns.AutoFit
        Next key

sht.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "All done!", vbExclamation

End Sub
 
Upvote 0
OK, this isn't my code originally (and I don't do much with Object programming), so I hope all my edits to the original code work:
VBA Code:
Sub Sunshine()

    Dim sht As Worksheet, ws As Worksheet, lr As Long, i As Long
    Dim DtID As Object, key As Variant
    Dim key2 As String
    
    Set sht = Sheets("Data")
    Set DtID = CreateObject("Scripting.Dictionary")
    lr = sht.Range("A" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        
    For i = 2 To lr
        If Not DtID.Exists(sht.Range("A" & i).Value) Then
            DtID.Add sht.Range("A" & i).Value, 1
        End If
    Next i
        
    For Each key In DtID.keys
    
        key2 = Format(key, "m-d-yyyy")
        
        If Not Evaluate("ISREF('" & key2 & "'!A1)") Then
              Worksheets.Add(after:=Sheets(Sheets.Count)).Name = key2
        End If
        
        Set ws = Sheets(key2)
        ws.UsedRange.Clear
        
        With sht.Range("A1:A" & lr)
            .AutoFilter 1, key2
            .Resize(, 24).Copy ws.[A1]
            .AutoFilter
        End With
        ws.Columns.AutoFit
        
    Next key

    sht.Select

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "All done!", vbExclamation

End Sub
 
Upvote 0
OK, this isn't my code originally (and I don't do much with Object programming), so I hope all my edits to the original code work:
VBA Code:
Sub Sunshine()

    Dim sht As Worksheet, ws As Worksheet, lr As Long, i As Long
    Dim DtID As Object, key As Variant
    Dim key2 As String
  
    Set sht = Sheets("Data")
    Set DtID = CreateObject("Scripting.Dictionary")
    lr = sht.Range("A" & Rows.Count).End(xlUp).Row
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      
    For i = 2 To lr
        If Not DtID.Exists(sht.Range("A" & i).Value) Then
            DtID.Add sht.Range("A" & i).Value, 1
        End If
    Next i
      
    For Each key In DtID.keys
  
        key2 = Format(key, "m-d-yyyy")
      
        If Not Evaluate("ISREF('" & key2 & "'!A1)") Then
              Worksheets.Add(after:=Sheets(Sheets.Count)).Name = key2
        End If
      
        Set ws = Sheets(key2)
        ws.UsedRange.Clear
      
        With sht.Range("A1:A" & lr)
            .AutoFilter 1, key2
            .Resize(, 24).Copy ws.[A1]
            .AutoFilter
        End With
        ws.Columns.AutoFit
      
    Next key

    sht.Select

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "All done!", vbExclamation

End Sub
?
THANK YOU
You solved it!
Now I have one last question:

If I rename my Workbook, do I need to rename the sub to the worksheet name instead of "Sunshine"?

1631897343303.png
 
Upvote 0
?
THANK YOU
You solved it!
Now I have one last question:

If I rename my Workbook, do I need to rename the sub to the worksheet name instead of "Sunshine"?

View attachment 47173
No, you can name your sub procedures to whatever you want. There is no need for them to match the worksheet name. That has no impact on anything.
 
Upvote 0
No, you can name your sub procedures to whatever you want. There is no need for them to match the worksheet name. That has no impact on anything.
WAIT.

Um. So new tabs are created, but data is not transferring:
For instance, this is for the tab dated 7-20-2021:

Sunshine.xlsm
ABCDEFGHIJKLMNOPQRSTUVWX
1DateWarehouseChannelShip ModePOShipmentBrandCarrierDCK_CMMTIn YardStatusShiftUserDck PODck UnitsDck CaseDck SKUDNRExpected UnitsExpected CaseRcvd UnitsRcvd CaseRcvd SKUPACKING_LIST_NO
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
7-20-2021


When the data in the data tab looks like this:
1631898033799.png
 
Upvote 0
Help ? . I'm doing this for a supervisor who is requesting this to be done by tomorrow if possible, and I don't know how to fix this.
 
Upvote 0
Hello Sunshine,

The problem that you appear to be having is with each "data dump" having different formatting. Going back to the code I first supplied, an amendment with a simple Replace/Replacement line of code as follows should take care of all Column A dates differing in format with each dump:-

VBA Code:
Option Explicit
Sub Sunshine()

        Dim sht As Worksheet, ws As Worksheet, lr As Long, i As Long
        Dim DtID As Object, key As Variant
    
        Set sht = Sheets("Data")
        Set DtID = CreateObject("Scripting.Dictionary")
        lr = sht.Range("A" & Rows.Count).End(xlUp).Row
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False
        
        sht.Columns("A").Replace What:="/", Replacement:="."  'Additional line of code.
        
        For i = 2 To lr
              If Not DtID.Exists(sht.Range("A" & i).Value) Then
              DtID.Add sht.Range("A" & i).Value, 1
              End If
        Next i
        
        For Each key In DtID.keys
              If Not Evaluate("ISREF('" & key & "'!A1)") Then
              Worksheets.Add(after:=Sheets(Sheets.Count)).Name = key
        End If
        
        Set ws = Sheets(key)
        ws.UsedRange.Clear
        
        With sht.Range("A1:A" & lr)
              .AutoFilter 1, key
              .Resize(, 24).Copy ws.[A1]
              .AutoFilter
        End With
              ws.Columns.AutoFit
        Next key

sht.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "All done!", vbExclamation

End Sub

The additional line of code is noted above. The code this time replaces all forward slashes with a dot(.).

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0
Solution
@Joe4:

Thanks Joe for helping the OP whilst I was sound asleep. Much appreciated.

Cheerio,
vcoolio.
 
Upvote 0

Forum statistics

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

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