VBA Math problem

[Derick63]

Hello all, Just registered but been using the forum as a major help resource but now I need help

Setup:
First of all, I'm relatively new to VBE but done quite a bit. I've built a UserForm utilizing a Combobox (ComboBox1) to choose one of 12 worksheets (Months) to enter the values from six (6) other controls on the UserForm. Below that Combobox I have a date picker (DTPicker) formatted MMMMdd, yyyy (CustomFormat) named (Reg1).

Here's my desire:
I need to alert the user when the date picked, minus 4 days, falls in the previous month suggesting to choose the correct month.

OR

When a date is selected in Reg1, minus the four (4) days then have the month from the date picker populate the ComboBox1 value.

I don't know how to approach this on the VBA side. It would surely save the user a lot of time.
I'm using Excel 2010
Thanks for your guruness with this.

Derick

 

[sheetspread]

Subtract 4 from the date and apply the month function.

 

[dreid1011]

Perhaps something like this:

Range("B1").Value = Format(Range("A1").Value - 4, "mmmm")

Replace Range("B1"). with your ComboBox1 and Range("A1"). with your date picker.

 

[Derick63]

Thanks, that's what I want done but I don't know how to do it.

 

[Derick63]

Perhaps something like this:

Range("B1").Value = Format(Range("A1").Value - 4, "mmmm")

Replace Range("B1"). with your ComboBox1 and Range("A1"). with your date picker.

Thanks, I tried your suggestion but nothing happened. I also tried this the following and nothing happened
Me.ComboBox1.Value = Format(Me.Reg1.Value - 4, "mmmm")
Here's the code on how I populated ComboBox1. I did it on the Initilize

Private Sub UserForm_Initialize()
'dim the variables
Dim ws As Worksheet
'loop through worksheets
For Each ws In Worksheets
'use the code name in case sheet name changes
Select Case ws.CodeName
'exclude these sheets by code name
Case "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet13", "Sheet14", "Sheet15", "Sheet16"
'Add the rest
Case Else
Me.ComboBox1.AddItem ws.Name
End Select
Next ws

'Set today's date for the DTPicker
Me.Reg1.Value = Date


End Sub

 

[dreid1011]

Here's a little bit of code I got to do what I think you want. The sub in red is what adds the value to the combo box. Now, we may need to add some code so it doesn't add duplicate entries in the combo box if you want to avoid that.

Private Sub UserForm_Initialize()
MonthView1.Value = Date - 1
ComboBox1.Clear
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
ComboBox1.AddItem Format(DateClicked - 4, "mmmm")
End Sub

 

[sheetspread]

This sample code may or may not help:

Sub datetest()
Dim x$
x = InputBox("enter a date")
If Month(DateValue(x) - 4) <> Month(Date) Then
MsgBox "You must choose a date at least 3 days after the first of this month (" & MonthName(Month(Date)) & ")"
Else: MsgBox "You entered a valid date: " & x
End If
End Sub

 

[Derick63]

Here's a little bit of code I got to do what I think you want. The sub in red is what adds the value to the combo box. Now, we may need to add some code so it doesn't add duplicate entries in the combo box if you want to avoid that.

Private Sub UserForm_Initialize()
MonthView1.Value = Date - 1
ComboBox1.Clear
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
ComboBox1.AddItem Format(DateClicked - 4, "mmmm")
End Sub

Thanks again for your effort but the only part that works is clearing the ComboBox1 and I don't want to clear it out because the code I posted for ComboBox reads all worksheet names (January through December) and populates ComboBox1 listing minus the sheets I don't want shown in the list. Yeah, can't have my cake and eat it too.

Maybe I should try this scenario; If Reg1 (the DTPicker box) date minus 4 days is less than the month in the date picked in Reg1 (the DTPicker box), then the message box appears.

Before constructing my Userform I used conditional formatting to format a datepicker cell red with a formula of =MONTH($B9)>MONTH($B9-4). $B9:$B50 are datepicker cells. That worked great without using a Userform but now that I am using a userform I can't see the sheet if there is a red cell. I don't know how to transfer that formula into VBA.

This is where I need the math:

Code needed for the DTPicker box, Reg1:
Private Sub Reg1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

'this is where I need the equivalent to: if Reg1 MONTH of the date chosen, is less than the MONTH of Reg1 date, minus 4 days, then, msgbox "This entry should be in the previous month!"


End Sub

I know it seems that I'm all over the place but I'm new to this and I can massage formulas all day to get exactly what I need but not in VBA...... Yet!

 

[Derick63]

This sample code may or may not help:

Sub datetest()
Dim x$
x = InputBox("enter a date")
If Month(DateValue(x) - 4) <> Month(Date) Then
MsgBox "You must choose a date at least 3 days after the first of this month (" & MonthName(Month(Date)) & ")"
Else: MsgBox "You entered a valid date: " & x
End If
End Sub

Hi, I tried your code with some mods but to no avail, it didn't work either.

Private Sub Reg1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
Dim x$
x = Me.Reg1.Value
If Month(DateValue(x) - 4) > Month(Date) Then
MsgBox "You must choose a date at least 3 days after the first of this month (" & MonthName(Month(Date)) & ")"
Else: MsgBox "You entered a valid date: " & x
End If
End Sub

 

[Derick63]

Thank you guys for your help. I replaced the ComboBox with a TextBox (TextBox1).
I'm using a ComboBox as a DTPicker (Reg1) which displays a user selected date. Reg1 sends the month to TextBox1.value after subtracting 4 days from the date chosen in Reg1. TextBox1.Value dictates which Sheet (Jan through Dec) to enter the other six TextBox values (Reg1 through Reg6) after clicking on the "Add Data" command button.

Private Sub Reg1_Change()
    Dim DT As Date
    
    DT = DateValue(Me.Reg1.Value)


    TextBox1.Value = Format(DT - 4, "mmmm")


End Sub

Thanks again.