(EDIT: To clarify, I'm running Excel 2013, so Microsoft's date picker isn't available.)
I'm trying to code a simple date picker - it'll be tidier when it's done, it's just big for simplicity while I build it - and everything populates as it should:
Me.Combo_Year.List = wsLU.Range("Date_Years").Value
Me.Combo_Month.List = wsLU.Range("Date_Months").Value
Me.Combo_Day.List = wsLU.Range("Date_Days31").Value
However, there are two instances where I'd like to set default values for the year, month and day comboboxes. For the times I'm using spin buttons, where a simple .Value statement sets them to 12 noon in the _Initialize. But neither .Value nor .Text works for the comboboxes:
Me.Combo_Year.Text = Year(Now()) ' Doesn't work
Me.Combo_Month.Text = Month(Now()) ' Doesn't work
Me.Combo_Day.Text = Day(Now()) ' Doesn't work
Me.Spin_Hour.Value = 12 ' Works fine
Me.Spin_Minute.Value = 0 ' Works fine
Similarly, when I try to set the date to a lower value when a month with fewer days is selected (to avoid returning the 31st of February, for instance), both .Value and .Text prove unhelpful again:
Is there any way to reliably set a default value and later change the value of a combobox in code? Am I missing something hugely obvious?
EDIT: For reference, the full code for the relevant parts of the form (UpdatePreview just updates the preview date above the OK button) as requested:
--------------------------------------------------------------------------------
Option Explicit
--------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
Dim wsLU As Worksheet, wbV As Workbook
Set wbV = ActiveWorkbook
Set wsLU = wbV.Worksheets("General Lookups")
Me.Combo_Year.List = wsLU.Range("Date_Years").Value
Me.Combo_Month.List = wsLU.Range("Date_Months").Value
Me.Combo_Day.List = wsLU.Range("Date_Days31").Value
Me.Combo_Minute.AddItem 0
Me.Combo_Minute.AddItem 30
' Tried putting the date numbers via variables instead of direct, with various data types
Dim TestYear As String, TestMonth As String, TestDay As String
TestYear = Year(Now())
TestMonth = Month(Now())
TestDay = Day(Now())
Lab_T_Year.Caption = TestYear
Lab_T_Month.Caption = TestMonth
Lab_T_Day.Caption = TestDay
'Me.Combo_Year.Text = TestYear ' If these lines are commented out the form will load, though without the comboboxes prepopulated
'Me.Combo_Month.Text = TestMonth ' If these lines are commented out the form will load, though without the comboboxes prepopulated
'Me.Combo_Day.Text = TestDay ' If these lines are commented out the form will load, though without the comboboxes prepopulated
' Original code; tried this both with and without various Format types.
'Me.Combo_Year.Value = Format(Year(Now()), "0000")
'Me.Combo_Month.Value = Format(Month(Now()), "00")
'Me.Combo_Day.Value = Format(Day(Now()), "00")
Me.Spin_Hour.Value = 12
Me.Combo_Minute.Value = 0 ' Switched the minute spinner to a combobox as the client wanted to just pick half hours (00/30) instead of minutes
UpdatePreview ' Updates date and time preview, works fine.
End Sub
--------------------------------------------------------------------------------
Private Sub Combo_Year_Change() ' Combo_Month_Change has an equivalent sub that essentially mirrors this one
Dim wsLU As Worksheet, wbV As Workbook
Set wbV = ActiveWorkbook
Set wsLU = wbV.Worksheets("General Lookups")
Dim iMonthNo As Integer, iYearNo As Long, iMaxDate As Integer
' Set number of days based on month
iMonthNo = Me.Combo_Month.ListIndex + 1
iYearNo = Me.Combo_Year.Value
If iMonthNo = 1 Or iMonthNo = 3 Or iMonthNo = 5 Or iMonthNo = 7 Or iMonthNo = 8 Or iMonthNo = 10 Or iMonthNo = 12 Then
Me.Combo_Day.List = wsLU.Range("Date_Days31").Value
iMaxDate = 31
ElseIf iMonthNo = 4 Or iMonthNo = 6 Or iMonthNo = 9 Or iMonthNo = 11 Then
Me.Combo_Day.List = wsLU.Range("Date_Days30").Value
iMaxDate = 30
ElseIf iMonthNo = 2 Then
Me.Combo_Day.List = wsLU.Range("Date_Days28").Value
iMaxDate = 28
' Leap year div by 4
If iYearNo / 4 = Int(iYearNo / 4) And Not (iYearNo / 100 = Int(iYearNo / 100)) Then Me.Combo_Day.List = wsLU.Range("Date_Days29").Value
If iYearNo / 4 = Int(iYearNo / 4) And Not (iYearNo / 100 = Int(iYearNo / 100)) Then iMaxDate = 29
' Leap year div by 400
If iYearNo / 4 = Int(iYearNo / 4) And iYearNo / 400 = Int(iYearNo / 400) Then Me.Combo_Day.List = wsLU.Range("Date_Days29").Value
If iYearNo / 4 = Int(iYearNo / 4) And iYearNo / 400 = Int(iYearNo / 400) Then iMaxDate = 29
End If
' Code to attempt to change the date down if Month is switched to one with fewer days. It doesn't work.
If Me.Combo_Day.Value > iMaxDate And iMonthNo > 0 And Not Me.Combo_Day.Value = "" Then Me.Combo_Day.Value = iMaxDate
UpdatePreview ' Updates date and time preview, works fine.
End Sub
THINGS WOT HAVEN'T WORKED:
Adding Microsoft's own date picker (not available in Excel 2013)
Installing the supplemental date picker as suggested by Microsoft (can't assume it'll be available on users' computers)
Attempts to directly set the comboboxes' .Text or .Value properties through VBA, regardless of data type used.
Attempts with dates directly (=Month(Now())), through variables (=sNowMonth), or by list index (Me.Combo_Month.Text=Me.Combo_Month.List(Month(Now())-1)).
I've been hunting around for a solution for this since last week. Every possibility I've found has been for older versions of Office. Can anyone help?
To answer your question directly, then you could make a date variable and then convert that to a text string:
Dim txtNowYear As String
Dim txtNowMonth As String
Dim txtNowDay As String
txtNowYear = Year(Now())
txtNowMonth = Month(Now())
txtNowDay = Day(Now())
Me.Combo_Year.Text = txtNowYear
Me.Combo_Month.Text = txtNowMonth
Me.Combo_Day.Text = txtNowDay
But depending on what you intend to use it for, it might be smarter to just change the input format to .Date
Go to Tools, Additional Control, select Microsoft Monthview Control 6.0 (SP6) And insert a date-picker in your form.
PS: A similar approach should be able to handle your second issue.
Related
(I'm a straight up beginner, first month of assignments of vba)
In my assignment, I was given an excel file with 4 sheets (of which, for my question, only the first three matter). Each of those first three's names end with the date (MM/YY) (0920, 1020 and 1120 respectively). In all those sheets I have two columns - one with a minimum value, and the other with the real value.
I need to create a procedure that, with a certain input of month and year, goes to the respective sheet and calculates how many cells with the real value have a value larger than their respective minimum value.
I tried this:
Sub ArtigosArmazem()
folhas = Array("Stock final 0920", "Stock final 1020", "Stock final 1120")
For i = LBound(folhas) To UBound(folhas)
Worksheets(folhas(i)).Activate
Next
Dim n As Integer
x = InputBox("Ano")
y = InputBox("Mês")
n = 0
If x = 2020 And y = setembro Then
i = "Stock final 0920"
For k = 3 To 510
If Cells(k, 8) > Cells(k, 7) Then
n = n + 1
End If
Next
MsgBox(n)
End If
End Sub
("Ano" means year, "Mês" means month and "setembro" means september in portuguese)
But it kept outputting "0" in the Message Box. Any help or tips?
If I understand the issue, then I think you need something like this using VBA.
Sub ArtigosArmazem()
Dim x as Integer
Dim y as String
Dim n as Integer
dim k as Integer
x = InputBox("Ano")
y = InputBox("Mês")
n = 0
If x = 2020 And y = "setembro" Then
Sheets("Stock final 0920").Activate
For k = 3 To 510
If Cells(k, 8) > Cells(k, 7) Then
n = n + 1
End If
Next
MsgBox(n)
End If
End Sub
With this method you have to watch out for the capitalization of "setembro". In VBA unlike Excel, "setembro" <> "Setembro".
It might be easier to use =SUMPRODUCT((H3:H510>G3:G510)*1) in each sheet instead of VBA.
This works in my version of Excel O365. I believe it will work in earlier versions as well.
I have the following code that is comparing a combobox on a userform(GUI) to a populated cell on sheet2 of my workbook and I am getting a "type mismatch" error. This was all working until another sub shifted some data into the cells being compared on sheet 2.
My issue lies with if Worksheets(sheet2).cells(1,i).value = LCase(GUI.superCB.Value) then
Worksheets(sheet2).cells(1,i).value Now shows up in the watch as a Variant/Integer which made me think that when the data was shifted it changed the "style" of that cell.
Private Sub NextButton_Click() ''' adds check boxes to frame
Dim i As Integer
'Dim superColm As Integer
For i = 5 To 12
If Worksheets(Sheet2).Cells(1, i).Value = LCase(GUI.superCB.Value) Then 'problem line is right here
superColm = i
Exit For
Else
End If
Next i
NextButton.Visible = False
superCB.Visible = False
Run.Visible = True
Frame1.Visible = True
Dim chk As Control
Dim idx As Integer
Dim lastrow As Integer
lastrow = Worksheets(Sheet2).Cells(Rows.Count, superColm).End(xlUp).Row
For idx = 1 To lastrow - 1
Set chk = GUI.Frame1.Controls.add("Forms.CheckBox.1", idx, True)
'set chk = gui.Frame1.Controls.Add(
chk.Visible = True
chk.Left = 5
chk.Top = (idx - 1) * (chk.Height + 2)
chk.Caption = Cells(idx + 1, superColm) & " " & idx
Next
With Me.Frame1
.ScrollBars = fmScrollBarsVertical
If lastrow <= 10 Then
.ScrollHeight = .InsideHeight * 1.5
ElseIf lastrow <= 15 Then
.ScrollHeight = .InsideHeight * 2.25
ElseIf lastrow <= 20 Then
.ScrollHeight = .InsideHeight * 3
ElseIf lastrow <= 25 Then
.ScrollHeight = .InsideHeight * 3.9
ElseIf lastrow <= 30 Then
.ScrollHeight = .InsideHeight * 4.75
ElseIf lastrow <= 35 Then
.ScrollHeight = .InsideHeight * 5.35
Else
.ScrollHeight = .InsideHeight * 6.25
End If
.ScrollWidth = .InsideWidth * 9
End With
End Sub
If I have sheet 2 as the active sheet Cells(1,i).value will work however, I need to have sheet 2 hidden from the user in the end. With this working it makes me think that the cell style is not the issue.
I have tried going to Excel.Workbooks("Shawn_sch_v1.2.xlsm").worksheets(sheet2).cells(1,i).value and everything down to the base cells() hoping it was missing a sheet reference but nothing has helped.
A String can safely be compared against any other data type in VBA... except Error.
Comparing a Variant/Error against anything will throw a type mismatch error.
This code is implicitly accessing whatever ActiveSheet is:
chk.Caption = Cells(idx + 1, superColm) & " " & idx
Cells should be qualified with the specific Worksheet object you mean to work with. If the active sheet contains a value that can't be coerced into a String (e.g. #VALUE! or #REF!), that will throw a type mismatch error.
Worksheets(Sheet2).Cells(1, i).Value = ...
Here Sheet2 is an identifier. The Worksheets indexer wants either an integer value, or a string. If Sheet2 is the code name of a worksheet in ThisWorkbook, you don't need to dereference it from Worksheets - just use it:
Sheet2.Cells(1, i).Value = ...
The Worksheet class doesn't have a default property, so Debug.Print Worksheets(Sheet2) throws error 438 object doesn't support this property or method - and a subsequent member call like .Cells(1, i), also throws a type mismatch error. If you don't have a Sheet2 string variable holding a worksheet name, I suspect that's the bug you're having right now... which means everything above is just what's waiting to bite you :)
If Sheet2 is a string variable that contains a valid sheet name, you can use the IsError function to verify whether a Variant is a Variant/Error:
If Not IsError(Sheet2.Cells(1, i).Value) Then
' value is safe to compare against a string
Else
' comparing the cell value to anything will throw error 13
End If
Lastly, I would advise against using Rows as a global variable, since it's already a global-scope identifier ([_Global].Rows, implicitly referring to ActiveSheet). Now, renaming that variable with Find/Replace is going to be pretty hard to do without breaking your code: Rubberduck's "rename" refactoring could probably help with doing that safely (disclaimer: I manage that OSS VBIDE add-in project).
This will be fixed with doing a check on the range object data type first.
Worksheets(Sheet2).Cells(1, i).Value is the range object. This can change data types every time the range is modified depending on how it is modified.
LCase(GUI.superCB.Value) This appears to be a form control. If the range is an integer, they cannot compare.
Try something like this:
Dim i As Integer
Dim iRange as String
'Dim superColm As Integer
`This is untested
For i = 5 To 12
iRange = Worksheets(sheet2).Cells(1, i).Text
If iRange = LCase(GUI.superCB.Value) Then 'problem line is right here
superColm = i
Exit For
Else
End If
Next i
The idea is to first be sure that the data types are the same.
You may need to use .Text or .Value2 instead of .Value for the range. If it is possible that the range object will be Empty or Nothing , then you also need to check for those too.
Edit: Changed .Value to .Text
Edit2: This answer is incorrect.
In excel I have the ID' numbers in column "A" starting on the second row (first row=header). In column "T" I have a duration for that ID on the same row.
In MS Project I have an ID column and an empty duration column. I want to add the duration from excel to MS Project on the correct ID row.
I think I can do this by using tasks and a For..To loop. I will need to use the ID in excel to look up the task in MS Project then write the duration from excel in the appropriate task in MS Project. So far, with some help, the code I have is:
'Find duration and assign to ID in Excel
For i = 2 To lastRow
date1 = .Cells(i, 15)
date2 = .Cells(i, 16)
If .Cells(i, 18).Value = "No" Then
answer = DateDiff("n", date1, date2)
.Cells(i, 20) = answer
End If
durationID = .Cells(i,1).Value
Next i
'Open MS Project and add Duration column
set wb = ActiveWorkBook
Set ws = wb.Sheets("Task_Table1")
Set appProj = CreateObject("Msproject.Application")
appProj.FileOpen "File1.mpp"
Set aProg = appProj.ActiveProject
appProj.Visible = True
lastTask = ActiveProject.Tasks.Count
taskID = ActiveProject.Tasks.ID
'Load Durations into MS Project to appropriate ID task
lastTask = ActiveProject.Tasks.Count
For i = 1 to lastTask
If taskID = Application.Workbooks("File1").Sheets("Task_Table1").Cells(i, 1).Value Then
answer.Copy
appProj.SelectCell.ActiveCell
end if
Next i
Instead of copying the duration into the user-interface, assign the duration directly to the task object. Alternatively (based on the comment below), update the Actual Start and Actual Finish date. Code to do both is included, but it doesn't make sense to update the duration if you are going to also update Actual Start and Actual Finish.
'Open MS Project
Set appProj = CreateObject("MSProject.Application")
appProj.FileOpen "File1.mpp"
Set aProg = appProj.ActiveProject
appProj.Visible = True
'Find duration and assign to task
Dim Duration As Long
Dim tsk as MSProject.Task
With ws
For i = 2 To lastRow
date1 = .Cells(i, 15)
date2 = .Cells(i, 16)
' get a reference to the task object using the ID stored in Column A
Set tsk = aProg.Tasks(.Cells(i, 1).Value)
' Update duration
If .Cells(i, 18).Value = "No" And IsDate(date1) And IsDate(date2) Then
TotalMinutes = DateDiff("n", date1, date2)
WorkingMinutes = appProj.DateDifference(date1, date2)
.Cells(i, 20) = WorkingMinutes
tsk.Duration = WorkingMinutes
End If
' update Actual Start and/or Actual Finish
If IsDate(date1) Then
tsk.ActualStart = date1
End If
If IsDate(date2) Then
tsk.ActualFinish = date2
End If
Next i
End With
Note that there are two calculations included for the duration. The VBA DateDiff function returns the total number of minutes between two dates, whereas the MS Project DateDifference function returns the number of working minutes between two dates. The latter is likely what you want to use. Otherwise a 1 day duration (1440 total minutes) will turn into a 3 day task (1440 = 3 days * 8 hours * 60 minutes/hour).
I have two "combo boxes" and one "txtbox" in my userform, In workbook "sheet1" i have names on column A and Month on column B and columns C to N are Jan. to Dec. which contain production hours for each name/specific month
-cboName
-cboMonth
-txtHours
I use below code to populate txtHours
Private Sub cboName_Change()
Dim EName As String
Dim Row, Col As Integer
EName = Me.cboName.Text
If EName <> "" Then
With Application.WorksheetFunction
Row = .Match(EName, Sheets("sheet1").Range("A2:A100"), 0)
GetMonthNum (Me.cboMonth.Text)
txtShiftHours.Value = Sheets("sheet1").Cells(Row + 1, Col + 3)
End With
End If
End Sub
Private Sub GetMonthNum(Month As String)
Select Case Month
Case Jan
Col = 3
Case Feb
Col = 4
Case Mar
Col = 5
Case Apr
Col = 6
Case May
Col = 7
Case June
Col = 8
Case July
Col = 9
Case Aug
Col = 10
Case Sept
Col = 11
Case Oct
Col = 12
Case Nov
Col = 13
Case Dec
Col = 14
End Select
End Sub
but regardless of month selection on cboMonth,txtProduct is populated with column 3 cuz this line
txtShiftHours.Value = Sheets("sheet1").Cells(Row + 1, Col + 3)
Please help me
thanks
You had several issues:
Your Case statements were checking the value of the String variable Month against undefined variables such as Jan, Feb, etc. This should have been checking against String literals such as "Jan", "Feb", etc.
In your GetMonthNum subroutine, you were assigning a value to an undefined variable Col.
In your cboName_Change subroutine you were using a variable Col which had never been assigned a value, so it would have had the default value of zero.
You also had some minor issues, which wouldn't have stopped your code from working, but could lead to problems down the track:
You used several variable names (Row, Month) which are the same as built in Functions / Properties within VBA. This is usually a very bad idea.
You declared Row as a Variant, despite declaring Col as an Integer.
It's a good idea to define row and column variables to be Long rather than Integer - the maximum number of rows in Excel is now 1048576, but an Integer can only hold numbers up to 65536.
It is also a good idea to always include the Option Explicit statement as the first line of each of your code modules. This tells the compiler to check that all your variables have been declared, and thus prevents many typos and attempts to use variables in one subroutine which are local to another subroutine.
I have refactored your code and hopefully it should now work.
Option Explicit
Private Sub cboName_Change()
Dim EName As String
Dim RowNum As Long, ColNum As Long
EName = Me.cboName.Text
If EName <> "" Then
With Application.WorksheetFunction
RowNum = .Match(EName, Sheets("sheet1").Range("A2:A100"), 0)
ColNum = GetMonthNum(Me.cboMonth.Text) + 2
txtShiftHours.Value = Sheets("sheet1").Cells(RowNum + 1, ColNum)
End With
End If
End Sub
Private Function GetMonthNum(Mth As String) As Long
Select Case Mth
Case "Jan": GetMonthNum = 1
Case "Feb": GetMonthNum = 2
Case "Mar": GetMonthNum = 3
Case "Apr": GetMonthNum = 4
Case "May": GetMonthNum = 5
Case "June": GetMonthNum = 6
Case "July": GetMonthNum = 7
Case "Aug": GetMonthNum = 8
Case "Sept": GetMonthNum = 9
Case "Oct": GetMonthNum = 10
Case "Nov": GetMonthNum = 11
Case "Dec": GetMonthNum = 12
End Select
End Function
You could use some of Excel's Date & Time built-in functions, to replace your entire Private Sub GetMonthNum(Month As String) with the 1 line of code below:
ColNum = Month(DateValue("1/" & Me.cboMonth.Text & "/2017")) + 2
Explanation: since your cboMonth Combo-Box has month strings in the mmm month format. If you select "Feb", then when you get to this section ("1/" & Me.cboMonth.Text & "/2017") you are getting "1/Feb/2017".
When adding DateValue before, you get 1/Feb/2017, and when adding the Month before, the result is 2.
I am having troubles with the coding above "9".
Sub ColourStates()
Dim intState As Integer
Dim strStateName As String
Dim intStateValue As Integer
Dim intColourLookup As Integer
Dim rngStates As Range
Dim rngColours As Range
Set rngStates = Range(ThisWorkbook.Names("STATES").RefersTo)
Set rngColours = Range(ThisWorkbook.Names("STATE_COLOURS").RefersTo)
With Worksheets("MainMap")
For intState = 1 To rngStates.Rows.Count
strStateName = rngStates.Cells(intState, 1).Text
intStateValue = rngStates.Cells(intState, 2).Value
' single colour
intColourLookup = Application.WorksheetFunction.Match(intStateValue, Range("STATE_COLOURS"), True)
With .Shapes(strStateName)
.Fill.Solid
.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup, 1).Offset(0, 1).Interior.Color
End With
Next
End With
End Sub
Here is the link to the file itself: https://dl.dropboxusercontent.com/u/41007907/MapOfStates.xls
It works fine for values below 9, but I need it to work until 20.
Your array STATE_COLORS includes only values within 0 to 9 interval. Here are the steps you need to proceed with:
1) open excel file
2) go to Formulas Tag
3) click on the Name Manager
4) choose STATE_COLORS arrays
5) increase the values to 20
Get back to me if you have any other questions.