VBA Code to auto date cells

data808

Active Member
Joined
Dec 3, 2010
Messages
353
Office Version
  1. 2019
Platform
  1. Windows
I have a merged C2 and D2 cell where I will type in the month "January" for example and another cell G2 that I will type in the year 2022. I will do this for every month. Is there a way based on which month and year I type into these cells, to auto populate 1/1/22 - 1/31/22 from cells A4 - A34? I realize that not every month has 31 days and so if these happens for February for example and goes to 2/31/22, that is ok. I am just trying to create a template and we will only be using the dates that we need to and ignore the dates and don't exist. Thanks.
 
This is the latest code I'm using
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2,G2,G4:G34"), Target) Is Nothing Then
        If [C2] = "" Or [G2] = "" Then
            Range("A4:A34").ClearContents
            ActiveSheet.Protect
            Exit Sub
        End If
       
        Application.EnableEvents = False
        Range("A4:A34").ClearContents
       
        Dim dFill As Long
        dFill = Day(WorksheetFunction.EoMonth((CDate("1/" & Evaluate("Month(1&C2)") & "/" & [G2])), 0))
        Range("A4").Value = Evaluate("Date(" & [G2] & "," & Evaluate("Month(1&C2)") & ",1)")
        Range("A4").AutoFill Range("A4").Resize(dFill), xlFillDays
       
        [G4:G34] = [INDEX(UPPER(G4:G34),)]
       
        Application.EnableEvents = True
    End If
End Sub
Ok I'll try this one. Thanks!
 
Upvote 0

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Ok I'll try this one. Thanks!
This is the latest code I'm using
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2,G2,G4:G34"), Target) Is Nothing Then
        If [C2] = "" Or [G2] = "" Then
            Range("A4:A34").ClearContents
            ActiveSheet.Protect
            Exit Sub
        End If
      
        Application.EnableEvents = False
        Range("A4:A34").ClearContents
      
        Dim dFill As Long
        dFill = Day(WorksheetFunction.EoMonth((CDate("1/" & Evaluate("Month(1&C2)") & "/" & [G2])), 0))
        Range("A4").Value = Evaluate("Date(" & [G2] & "," & Evaluate("Month(1&C2)") & ",1)")
        Range("A4").AutoFill Range("A4").Resize(dFill), xlFillDays
      
        [G4:G34] = [INDEX(UPPER(G4:G34),)]
      
        Application.EnableEvents = True
    End If
End Sub
Ok so I made a a copy of the file and pasted your code exactly and it still goes into march from february and the uppercase did work for a while but i think after testing the C2 and G2 like deleting the data I think it caused the uppercase code to stop working. Once you save the file from that code stopping it won't work unless I probably make another file and paste your code again from scratch.

It's crazy how that month thing stops for you and doesn't auto populate the next month. That is really cool.
 
Upvote 0
Depending on when your code "stopped working", your EnableEvents might still be set to False. You need to turn them to True. Run this short code to be sure:

VBA Code:
Sub Test()
Application.EnableEvents = True
End Sub

Apart from that, as you could see from post #48, the code works fine for me and I don't know why it doesn't for you. So unfortunately, I don't see how I can be of any further assistance. Hopefully, someone else on this forum may come to the rescue :)
 
Upvote 0
Depending on when your code "stopped working", your EnableEvents might still be set to False. You need to turn them to True. Run this short code to be sure:

VBA Code:
Sub Test()
Application.EnableEvents = True
End Sub

Apart from that, as you could see from post #48, the code works fine for me and I don't know why it doesn't for you. So unfortunately, I don't see how I can be of any further assistance. Hopefully, someone else on this forum may come to the rescue :)
No problem @kevin9999 you have done so much to help with this and I really appreciate it. I'll do more testing and see if I can figure the rest out. Thanks again!
 
Upvote 0
No problem @kevin9999 you have done so much to help with this and I really appreciate it. I'll do more testing and see if I can figure the rest out. Thanks again!
Going to keep posting as I figure out more solutions. So for the line:

[G4:G34] = [INDEX(UPPER(G4:G34),)]

To get this to work more properly, I pasted it in the ChangeSelection event and now it works flawlessly. I guess it needed its own event because it didn't cover all scenarios when in the Change event and it's location in the lines of code. Sometimes it would lose it's trigger if I deleted that values from C2 or G2 and then try to enter initials. It wouldn't work again until C2 and G2 had values in those cells simultaneously.

Now just need to figure out why my dates are not stopping for February and I assume other short months that are not 31 days. It will always go on into the next month.
 
Upvote 0
Depending on when your code "stopped working", your EnableEvents might still be set to False. You need to turn them to True. Run this short code to be sure:

VBA Code:
Sub Test()
Application.EnableEvents = True
End Sub

Apart from that, as you could see from post #48, the code works fine for me and I don't know why it doesn't for you. So unfortunately, I don't see how I can be of any further assistance. Hopefully, someone else on this forum may come to the rescue :)
@kevin9999 by any chance would you be able to upload your file so that I can download it? I want to see it in action.
 
Upvote 0
Revisiting this after seeing This thread where @Joe4 came up with a novel approach. Try this:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2,G2,G4:G34"), Target) Is Nothing Then
        
        If [C2] = "" Or [G2] = "" Then
            Range("A4:A34").ClearContents
            Exit Sub
        End If
        
        Application.EnableEvents = False
        Range("A4:A34").ClearContents
        
        Dim cMonth As Long, dFill As Long
        
        cMonth = Month(DateValue([C2] & " 1 " & [G2]))
        
        Select Case cMonth
            Case 2
                If [G2] Mod 4 = 0 Then dFill = 29 Else dFill = 28
            Case 4, 6, 9, 11
                dFill = 30
            Case Else
                dFill = 31
        End Select
        
        Range("A4").Value = Evaluate("Date(" & [G2] & "," & Evaluate("Month(1&C2)") & ",1)")
        Range("A4").AutoFill Range("A4").Resize(dFill), xlFillDays
        
        [G4:G34] = [INDEX(UPPER(G4:G34),)]
        
        Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
Solution
Revisiting this after seeing This thread where @Joe4 came up with a novel approach. Try this:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2,G2,G4:G34"), Target) Is Nothing Then
       
        If [C2] = "" Or [G2] = "" Then
            Range("A4:A34").ClearContents
            Exit Sub
        End If
       
        Application.EnableEvents = False
        Range("A4:A34").ClearContents
       
        Dim cMonth As Long, dFill As Long
       
        cMonth = Month(DateValue([C2] & " 1 " & [G2]))
       
        Select Case cMonth
            Case 2
                If [G2] Mod 4 = 0 Then dFill = 29 Else dFill = 28
            Case 4, 6, 9, 11
                dFill = 30
            Case Else
                dFill = 31
        End Select
       
        Range("A4").Value = Evaluate("Date(" & [G2] & "," & Evaluate("Month(1&C2)") & ",1)")
        Range("A4").AutoFill Range("A4").Resize(dFill), xlFillDays
       
        [G4:G34] = [INDEX(UPPER(G4:G34),)]
       
        Application.EnableEvents = True
    End If
End Sub
Works fantastic!! I just want to say thank you so much for taking the time to search other threads to find this.

Also want to point out that I took out the [G4:G34] = [INDEX(UPPER(G4:G34),)] line because it wasn't working properly if C2 or G2 cells were not filled because it would just exit sub. I found that plugging it in to the SelectionChange event worked best.

Thanks again for the help.
 
Upvote 0
Works fantastic!! I just want to say thank you so much for taking the time to search other threads to find this.

Also want to point out that I took out the [G4:G34] = [INDEX(UPPER(G4:G34),)] line because it wasn't working properly if C2 or G2 cells were not filled because it would just exit sub. I found that plugging it in to the SelectionChange event worked best.

Thanks again for the help.
Glad we could help, and thanks for the feedback :)
 
Upvote 0
Works fantastic!! I just want to say thank you so much for taking the time to search other threads to find this.
The marked solution has been switched accordingly.

@data808 - in your future questions, please mark the post as the solution that answered your question to help future readers. No further action is required in this thread.
 
Upvote 0

Forum statistics

Threads
1,214,897
Messages
6,122,141
Members
449,066
Latest member
Andyg666

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