VBA Code to auto date cells

D

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.
 
Sort by date Sort by votes
kevin9999 said:
Did you try the code from post #32 without the added extras to see if that worked? NB: don't use "On Error Resume Next "- it hides errors it doesn't fix them.
Click to expand...
I was just about to say the same thing.
don't use "On Error Resume Next "- it hides errors it doesn't fix them.
 
Upvote 0

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
If you want to add the uppercase code, then try it like this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2,G2"), 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 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
 
Upvote 0
kevin9999 said:
Did you try the code from post #32 without the added extras to see if that worked? NB: don't use "On Error Resume Next "- it hides errors it doesn't fix them.
Click to expand...
Ok its working now without my upper case code. I did find one error and that is if the user types something other than a year into G2 cell it gets an error. Other than that its working as it should. I also had to put in some lines of activesheets.protect and activesheets.unprotect to get it to work since this sheet is protected. This is what I'm using now:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C2,G2"), Target) Is Nothing Then

If [C2] = "" Or [G2] = "" Then
ActiveSheet.Unprotect
Range("A4:A34").ClearContents
ActiveSheet.Protect
Exit Sub
End If

Application.EnableEvents = False
ActiveSheet.Unprotect
Range("A4:A34").ClearContents
ActiveSheet.Protect

Dim dFill As Long
dFill = Day(WorksheetFunction.EoMonth((CDate("1/" & Evaluate("Month(1&C2)") & "/" & [G2])), 0))
ActiveSheet.Unprotect
Range("A4").Value = Evaluate("Date(" & [G2] & "," & Evaluate("Month(1&C2)") & ",1)")
Range("A4").AutoFill Range("A4").Resize(dFill), xlFillDays
ActiveSheet.Protect

Application.EnableEvents = True
End If
End Sub
 
Upvote 0
kevin9999 said:
If you want to add the uppercase code, then try it like this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2,G2"), 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 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
Click to expand...
Thanks @kevin9999 the upper case line didn't do anything unfortunately.
 
Upvote 0
data808 said:
Ok its working now without my upper case code. I did find one error and that is if the user types something other than a year into G2 cell it gets an error. Other than that its working as it should. I also had to put in some lines of activesheets.protect and activesheets.unprotect to get it to work since this sheet is protected. This is what I'm using now:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C2,G2"), Target) Is Nothing Then

If [C2] = "" Or [G2] = "" Then
ActiveSheet.Unprotect
Range("A4:A34").ClearContents
ActiveSheet.Protect
Exit Sub
End If

Application.EnableEvents = False
ActiveSheet.Unprotect
Range("A4:A34").ClearContents
ActiveSheet.Protect

Dim dFill As Long
dFill = Day(WorksheetFunction.EoMonth((CDate("1/" & Evaluate("Month(1&C2)") & "/" & [G2])), 0))
ActiveSheet.Unprotect
Range("A4").Value = Evaluate("Date(" & [G2] & "," & Evaluate("Month(1&C2)") & ",1)")
Range("A4").AutoFill Range("A4").Resize(dFill), xlFillDays
ActiveSheet.Protect

Application.EnableEvents = True
End If
End Sub
Click to expand...
As long as it's working for you now, that's the main thing. You might want to consider (as I did with the test sheet I used) a data validation for cell G2 - whole number/minimum to maximum - to prevent anything other than appropriate years being entered.
 
Upvote 0
data808 said:
Thanks @kevin9999 the upper case line didn't do anything unfortunately.
Click to expand...
kevin9999 said:
If you want to add the uppercase code, then try it like this:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("C2,G2"), 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 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
Click to expand...

Ok I did a data validation for the G2 year cell and that will prevent the error since the users will have select from the drop down list of valid values. I think I can figure out the upper case issues eventually but would you happen to know how to prevent the shorter months from auto populating the next month?
 
Upvote 0
kevin9999 said:
As long as it's working for you now, that's the main thing. You might want to consider (as I did with the test sheet I used) a data validation for cell G2 - whole number/minimum to maximum - to prevent anything other than appropriate years being entered.
Click to expand...
Wow I just posted a reply doing exactly what you suggested. Thanks.
 
Upvote 0
data808 said:
Ok I did a data validation for the G2 year cell and that will prevent the error since the users will have select from the drop down list of valid values. I think I can figure out the upper case issues eventually but would you happen to know how to prevent the shorter months from auto populating the next month?
Click to expand...
I thought that issue had already been resolved? This is what I'm getting when I run the latest code (note that I've added to the intersect range to address the upper case issue)

Before (March 2022)

dates.xlsm
ABCDEFG
1ORDERS
2MONTH:MarchYEAR:2022
3Folder DateReceived DatePONOSNTOTALINITIALS/NOTES
43/1/2022
53/2/2022
63/3/2022
73/4/2022
83/5/2022
93/6/2022
103/7/2022
113/8/2022
123/9/2022
133/10/2022
143/11/2022
153/12/2022
163/13/2022
173/14/2022
183/15/2022
193/16/2022
203/17/2022
213/18/2022
223/19/2022
233/20/2022
243/21/2022
253/22/2022
263/23/2022
273/24/2022
283/25/2022
293/26/2022
303/27/2022
313/28/2022
323/29/2022
333/30/2022
343/31/2022
35
Sheet1
Cells with Data Validation
CellAllowCriteria
C2:D2ListJanuary, February, March, April, May, June, July, August, September, October, November, December
G2Whole numberbetween 2020 and 2050


Change to February...

dates.xlsm
ABCDEFG
1ORDERS
2MONTH:FebruaryYEAR:2022
3Folder DateReceived DatePONOSNTOTALINITIALS/NOTES
42/1/2022
52/2/2022
62/3/2022
72/4/2022
82/5/2022
92/6/2022
102/7/2022
112/8/2022
122/9/2022
132/10/2022
142/11/2022
152/12/2022
162/13/2022
172/14/2022
182/15/2022
192/16/2022
202/17/2022
212/18/2022
222/19/2022
232/20/2022
242/21/2022
252/22/2022
262/23/2022
272/24/2022
282/25/2022
292/26/2022
302/27/2022
312/28/2022
32
33
34
Sheet1
Cells with Data Validation
CellAllowCriteria
C2:D2ListJanuary, February, March, April, May, June, July, August, September, October, November, December
G2Whole numberbetween 2020 and 2050


I just can't understand why it's not working for you...
 
Upvote 0
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
 
Upvote 0
kevin9999 said:
I thought that issue had already been resolved? This is what I'm getting when I run the latest code (note that I've added to the intersect range to address the upper case issue)

Before (March 2022)

dates.xlsm
ABCDEFG
1ORDERS
2MONTH:MarchYEAR:2022
3Folder DateReceived DatePONOSNTOTALINITIALS/NOTES
43/1/2022
53/2/2022
63/3/2022
73/4/2022
83/5/2022
93/6/2022
103/7/2022
113/8/2022
123/9/2022
133/10/2022
143/11/2022
153/12/2022
163/13/2022
173/14/2022
183/15/2022
193/16/2022
203/17/2022
213/18/2022
223/19/2022
233/20/2022
243/21/2022
253/22/2022
263/23/2022
273/24/2022
283/25/2022
293/26/2022
303/27/2022
313/28/2022
323/29/2022
333/30/2022
343/31/2022
35
Sheet1
Cells with Data Validation
CellAllowCriteria
C2:D2ListJanuary, February, March, April, May, June, July, August, September, October, November, December
G2Whole numberbetween 2020 and 2050


Change to February...

dates.xlsm
ABCDEFG
1ORDERS
2MONTH:FebruaryYEAR:2022
3Folder DateReceived DatePONOSNTOTALINITIALS/NOTES
42/1/2022
52/2/2022
62/3/2022
72/4/2022
82/5/2022
92/6/2022
102/7/2022
112/8/2022
122/9/2022
132/10/2022
142/11/2022
152/12/2022
162/13/2022
172/14/2022
182/15/2022
192/16/2022
202/17/2022
212/18/2022
222/19/2022
232/20/2022
242/21/2022
252/22/2022
262/23/2022
272/24/2022
282/25/2022
292/26/2022
302/27/2022
312/28/2022
32
33
34
Sheet1
Cells with Data Validation
CellAllowCriteria
C2:D2ListJanuary, February, March, April, May, June, July, August, September, October, November, December
G2Whole numberbetween 2020 and 2050


I just can't understand why it's not working for you...
Click to expand...
Oh yeah mine doesn't stop like yours. After February 28th it goes into March up to the 3rd. Could it because I copied the post #32 code and that was before you fixed the issue?
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Locked
  • Question
Bi-Monthly cut-off payroll period
Replies
1
Views
213
Peter_SSs
Peter_SSs
A
  • Question
Date setting according to year and month selection
Replies
1
Views
157
LazyBug
LazyBug
E
  • Question
24 month account
Replies
5
Views
227
ExcelSwede
E
A
  • Solved
Auto-Update Date Based on Cell Input
Replies
8
Views
175
acool
A
R
  • Solved
VBA Help to Automate Year
Replies
2
Views
160
RattlingCarp3048
R

Forum statistics

Threads
1,215,644
Messages
6,125,992
Members
449,278
Latest member
MOMOBI

Share this page

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