Extract date format from sheet name

[Vincent88]

Hi Guys,
My sheet named as 2021(07) and I use below cell function code to extract its year, month and date to a cell C1.

=DATE(LEFT(MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255),4),MID(CELL("filename",A1),FIND("(",CELL("filename",A1))+1,FIND(")",CELL("filename",A1))-FIND("(",CELL("filename",A1))-1),1)

If my sheetname date format changed to 202107, what is the VBA code to extract the date form to 1-Jul to cell D1 and rest of the days (till 31st to cell AH1 and 30-Jun in C1).
Thanks.

 

[Peter_SSs]

You're welcome. Glad we could help.

 

[Vincent88]

If you want to apply this to all worksheets (that are named with 6 digits) then you could just run the code below from a standard module, rather than repeating it in every such worksheet.

Sub Fill_Dates_v2()
  Dim ws As Worksheet
 
  For Each ws In Worksheets
    If ws.Name Like "######" Then
      With ws
        .Range("C1").Value = DateSerial(Left(.Name, 4), Right(.Name, 2), -4)
        .Range("C1").DataSeries xlRows, xlChronological, xlDay, 1, DateSerial(Left(.Name, 4), Right(.Name, 2) + 1, 0)
      End With
    End If
  Next ws
End Sub

Hi Peter SSs,
I just realized, while copying sheet, if the new month is less than 31 days, the last cell does not change (see image uploaded) to the date of month after next. ( If the month is February, then there will be more cells not showing the dates of March)
I tried to add autofill to Range("C1").DataSeries xlRows, xlChronological, xlDay, 1, DateSerial(Left(.Name, 4), Right(.Name, 2) + 1, 0) but it does not work. Please help.

 

[Peter_SSs]

I just realized, while copying sheet, if the new month is less than 31 days, the last cell does not change (see image uploaded)

Ah, you didn't mention that you would be copying these sheets or that there might already be data in row 1.

Try adding this line

Sub Fill_Dates_v3()
  Dim ws As Worksheet
  
  For Each ws In Worksheets
    If ws.Name Like "######" Then
      With ws
        .Range("C1").Resize(, 36).ClearContents
        .Range("C1").Value = DateSerial(Left(.Name, 4), Right(.Name, 2), -4)
        .Range("C1").DataSeries xlRows, xlChronological, xlDay, 1, DateSerial(Left(.Name, 4), Right(.Name, 2) + 1, 0)
      End With
    End If
  Next ws
End Sub

 

[Vincent88]

Ah, you didn't mention that you would be copying these sheets or that there might already be data in row 1.

Try adding this line

Sub Fill_Dates_v3()
  Dim ws As Worksheet
 
  For Each ws In Worksheets
    If ws.Name Like "######" Then
      With ws
        .Range("C1").Resize(, 36).ClearContents
        .Range("C1").Value = DateSerial(Left(.Name, 4), Right(.Name, 2), -4)
        .Range("C1").DataSeries xlRows, xlChronological, xlDay, 1, DateSerial(Left(.Name, 4), Right(.Name, 2) + 1, 0)
      End With
    End If
  Next ws
End Sub

Hi Peter SSs,
Additional code works -with blank cells after the last day of that month. If I want to show the dates of next month instead of blank, what should be amended.

 

[Peter_SSs]

If I want to show the dates of next month

How many days of the next month do you want to show?

 

[Vincent88]

Hi Peter SSs,
If the blank cell is just one, then show the 1st day of next month but for the month of February with 28 days, then shows March 1, 2, and 3. In other word, blank cells between C1 to AL1 should only be found in AJ1, AK1 and AL1. Hope this helps you to figure out the resolution for me. Many thanks.

 

[Peter_SSs]

Try

Sub Fill_Dates_v4()
  Dim ws As Worksheet
  
  For Each ws In Worksheets
    If ws.Name Like "######" Then
      With ws
        .Range("C1").Resize(, 36).ClearContents
        .Range("C1").Value = DateSerial(Left(.Name, 4), Right(.Name, 2), -4)
        .Range("C1").DataSeries xlRows, xlChronological, xlDay, 1, .Range("C1").Value + 35
      End With
    End If
  Next ws
End Sub