I have a drop down box, the items are depending on the regional settings:
Private Sub UserForm_Initialize()
Select Case Application.International(XlApplicationInternational.xlCountryCode)
Case 1: 'English
With ComboBox1
.AddItem "January"
...etc
End With
Case 36: 'Hungarian
With ComboBox1
.AddItem "Január"
...etc
End with
Case 49: 'German
With ComboBox1
.AddItem "Januar"
...etc
End with
End Select
End Sub
Later I use the selected value in this code:
Year_1 = 2017 'integer
Day_1 = 1 'integer
Date_from_userform = CDate(Year_1 & "-" & UserForm1.ComboBox1.Value & "-" & Day_1) 'date
In German environment, it works perfect, but I tested in Hungarian environment, and I get every time type mismatch.
The Cdate does not accept the 2017-Január-1. (Th excel was Hungarian)Why?
If the month depends on the regional settings, it should work...
(Or should I convert the Values from the dropdownbox into numbers?)
I would use the Format function, the DateSerial function and the ComboBox1.ListIndex property.
Private Sub CommandButton1_Click()
Year_1 = 2017 'integer
Day_1 = 1 'integer
Date_from_userform = DateSerial(Year_1, ComboBox1.ListIndex + 1, Day_1)
End Sub
Private Sub UserForm_Initialize()
For i = 1 To 12
ComboBox1.AddItem Format(DateSerial(Year(Date), i, 1), "mmmm")
Next
End Sub
Instead of writing all the months yourself (and possible risk a misspelling) I'd use the following approach to write the months "names" for you:
Public Sub getMonthNamesWrittenOutInDifferentLanguages()
Dim i As Integer
'Hungarian:
For i = 1 To 12
Debug.Print Application.WorksheetFunction.Text(DateSerial(2017, i, 1), "[$-40e]MMMM")
Next i
'English:
For i = 1 To 12
Debug.Print Application.WorksheetFunction.Text(DateSerial(2017, i, 1), "[$-809]MMMM")
Next i
'German:
For i = 1 To 12
Debug.Print Application.WorksheetFunction.Text(DateSerial(2017, i, 1), "[$-de-DE]MMMM")
Next i
End Sub
Afterwards, you can use the same code to easily go through all the possible month names and convert them back to dates:
strDate = "2017-Januar-05"
For i = 1 To 12
strDate = Replace(strDate, Application.WorksheetFunction.Text(DateSerial(2017, i, 1), "[$-de-DE]MMMM"), i)
Next i
Debug.Print IsDate(strDate)
Debug.Print CDate(strDate)
Related
I've put together a macro that is meant to increase dates by one in an array of 7 cells ("B2:H2"), (reflecting 7d in a week) once B2 value is changed.
I am sure there is a better way of writing this:
Sub Date_Increment
' increases consecutive days by 1
Range("c2").Value = Range("b2").Value + 1
Range("d2").Value = Range("c2").Value + 1
Range("e2").Value = Range("d2").Value + 1
Range("f2").Value = Range("e2").Value + 1
Range("g2").Value = Range("f2").Value + 1
Range("h2").Value = Range("g2").Value + 1
End Sub
This feels a bit too Neanderthal.
Much appreciate any help.
Use loop. Try-
Sub Date_Increment()
Dim i As Integer
For i = 1 To 7
Cells(2, 2 + i) = Cells(2, 2).Value + i
Next i
End Sub
You can try this:
Sub Date_Increment
' increases consecutive days by 1
Dim i as Long
For i=1 to 6
Range("c2").Cells(i,1).Value = Range("b2").Cells(i,1).Value + 1
Next i
End Sub
Note: Range("c2") implies ActiveSheet.Range("c2") so unless this is code under a specific worksheet you need to be aware that it will only work if the sheet holding the dates is the active sheet.
See if below code is useful for you.
Sub Date_Increment2()
With Range("C2:H2")
.Formula = "=B2+1"
.Value = .Value
End With
End Sub
Personally, I'd leave cell C2 onwards as formula cells as then any change in B2 would get reflected immediately.
I have the following userform:
Using the code below I can save the names of each selected checkbox into a sheet. The value will be saved in the same column, but on different rows (of course), as more than 1 checkbox can be selected.
Dim indProdWs As Worksheet
Dim ctl As Control
Dim i As Long
Set indProdWs = tWb.Worksheets("INDICATION-PRODUCT")
i = 4
' This is the row where i want to save the first value
For Each ctl In seg_multipage.Pages(1).Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value = True Then
indProdWs.Cells(i, 9) = ctl.Caption: i = i + 1
End If
End If
Next ctl
However, as you can see in the first image, for each row of products there's a label.
This is what I want to accomplish:
If Product 22 in the second row is selected, then I want the name to be saved on the cell with the following format:
Label2 - Product22
Or if Product 51 in the second row is selected:
Label 5 - Product 51
As you can see, the label number always matches the first digit of the product. I tried using that as a variable, but I haven't been successful.
Thank you for any help you can give me!
is the name actually "Product22" or this just an example? – Siddharth Rout 6 mins ago
#SiddharthRout just an example, but the format is similar. An actual name is seg_cb_selInd_22 (for example). – soraia635 1 min ago
Is this what you are trying?
Change the For - Next code to the below
For Each ctl In seg_multipage.Pages(1).Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value = True Then
indProdWs.Cells(i, 9) = Controls("seg_l_selInd_" & _
GetNumber(ctl.Name)).Caption & _
" - " & _
ctl.Name
i = i + 1
End If
End If
Next ctl
and then add this function to your code
Private Function GetNumber(s As String)
Dim numb As Long
Dim i As Long
For i = 1 To Len(s)
Select Case Mid(s, i, 1)
Case 0 To 9
numb = Mid(s, i, 1)
Exit For
End Select
Next
GetNumber = numb
End Function
Note: This function assumes that you will pass an Alphanumeric string to it.
I am trying to insert a value into my excel sheet and it keeps changing the string into a date. For example, I am trying to past 2-4 (One of the names for one Unit we use) and instead, I get February 4, 2020. Is there a way to prevent it from being changed?
x = 5
For i = 1 To TheEnd - 1
If IsEmpty(LANL(i, 1)) Then
If Percent(i, 1) = 1 Then
Cells(x, 1) = SU(i, 1)
x = x + 1
End If
End If
Next i
If we do something like:
Sub qwerty()
With ActiveCell
.Clear
.NumberFormat = "#"
.Value = "2-4"
.ClearFormats
End With
End Sub
Our result would be:
I am adding TextBoxes dynamically in a userform and want to make them a date format to ensure correct date entry. I am unable to find any examples.
Here is my code for the userform activation:
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
fltDays = TextBox3.Value If TextBox3.Value = 0 Then Exit Sub
For i = 1 To fltDays
n = i - 1
Dim TextBox As Control
Set theLbl = FloatDayFrm.Controls.add("Forms.Label.1", "lbl_" & i, True)
With theLbl
.Caption = "Day " & i
.Left = 20
.Width = 60
.Top = n * 24 + 100
.Font.Size = 10
End With
Set TextBox = FloatDayFrm.Controls.add("Forms.TextBox.1", "TextBox_" & n, True)
With TextBox
.Top = 100 + (n * 24)
.Left = 90
.Height = 18
.Width = 50
.Name = "txtBox" & i
.Font.Size = 10
.TabIndex = n + 4
.TabStop = True
End With Next i
FloatDayFrm.Height = 150 + fltDays * 24 With btnOK .Top = 102 + fltDays * 24 .TabStop = True .TabIndex = n + 5 End With
With btnCancel .Top = 102 + fltDays * 24 '.TabStop = True .TabIndex = n + 6 End With
End Sub
This is my code for the Command button:
Private Sub btnOK_Click()
n = TextBox3.Value
For j = 1 To n
Set varFloatDay = FloatDayFrm.Controls("txtBox" & j)
Select Case varFloatDay
Case ""
MsgBox "Day " & j & " can't be blank", vbOKOnly, "Incorrect Value"
Exit Sub
Case Is > TextBox2.Value
MsgBox "Date is after end date", vbOKOnly, "Incorrect Value"
Exit Sub
Case Is < TextBox1.Value
MsgBox "Date is BEFORE end date", vbOKOnly, "Incorrect Value"
Exit Sub
End Select
Next j
End Sub
Any help would be appreciated.
You have to convert text to date format. You can use multiple approach.
Add a label beside textbox to display the format user has to specify the date. Parse the text specified by user as per the format. Do validation and conversion as shown in code below.
Use a calendar control instead of textbox as user input.
Have separate textboxes or cells for year, month and day. Do validation and conversion as shown in code below.
If you are sure date is in the specified format as per regional setting. Do validation and conversion as shown in code below.
Try below
Private Sub TestDate()
Dim yr As Integer
Dim mnth As Integer
Dim day As Integer
Dim dt As Date
Dim strDate As String
'''''3rd approach''''''
yr = ActiveSheet.Range("A1")
mnth = ActiveSheet.Range("B1")
day = ActiveSheet.Range("C1")
If IsNumeric(yr) And IsNumeric(mnth) And IsNumeric(day) Then
If yr < 0 Or mnth < 0 Or day < 0 Then
MsgBox "Year, Month and Day must be greater than 0."
Exit Sub
End If
Else
MsgBox "Year, Month and Day must be an integer."
Exit Sub
End If
'convert to Date
dt = DateSerial(yr, mnth, day)
'''''4th approach''''''
'Display a date according to your system's short date format
'i.e. regional settings in control panel
strDate = Format(ActiveSheet.Range("D1"), "Short Date")
If Not IsDate(strDate) Then
MsgBox "Incorrect Date Format"
Exit Sub
End If
dt = CDate(strDate)
End Sub
Any input in a text box is a text string. If you want it to be a date you can use IsDate(TextBox1.Value) to determine if VBA is able to convert the string to a date (which is a number of Double type). VBA will not execute this test 100% correctly, however. For example, it may not recognised 3/2/17 as a date if your regional settings have the date separator as a period. It may convert 3.2.17 to March 2 if your regional settings are mm.dd.yy. While working on your own PC you may be able to control the regional settings. But if your project will be released into the wild it is better to use a calendar control to get a correct date.
Private Sub txtTotal1_Change()
Dim Final As Integer
If cbOldf_Change() Then
olf1 = cbOldf.ActiveCell.Offset(0, 1)
Final = oldf_col * quantity
ElseIf cbHaribo1_Change() Then
haribo1 = cbHaribo1.ActiveCell.Offset(0, 1) + 1
Final = haribo_col * quantity
ElseIf cbOldf_Change() = cbHaribo1_Change() Then
oldf_1 = cbOldf.ActiveCell.Offset(0, 1) + 1
haribo1 = cbHaribo1.ActiveCell.Offset(0, 1) + 1
Final = oldf_1 + haribo1 * quantity
End If
If txtQuantity1_Change() Then
txtTotal.Value = Final
End Sub
I am new at vba. I have two worksheets for seperate products (haribo and old favourites) I have combo boxes to grab products from those worksheets and a text box to enter quantities. In the products worksheets the product name is in column A and the price is in column B. What I want to achieve is to be able to select a product name from the combo box, enter a quantity in the text box and have the total price be calculated and then displayed in a "total" textbox.
I am new at this so please look past my awful code, I have given it an honest 5 or so hours of effort and I am now at my wits end! I would love some help or to be pointed in the right direction please.
EDIT: Here is my workbook https://www.dropbox.com/s/49iym4exbcgmhcq/Main%20Page.xlsm
I am doing this for college as you may guess by looking at it
Try to use this code to set the total:
Private Sub SetTotal()
Dim dblTotal As Double
Dim dblQuantity As Double
If IsNumeric(Me.txtQuantity1) Then
dblQuantity = CDbl(Me.txtQuantity1)
End If
If cbHaribo1.Value <> "" Then
dblTotal = dblQuantity * GetPrice(Sheets("HARIBO").Range("A:B"), cbHaribo1.Value)
End If
If Me.cbOldf.Value <> "" Then
dblTotal = dblTotal + dblQuantity * GetPrice(Sheets("OLDFAVORITES").Range("A:B"), cbOldf.Value)
End If
Me.txtTotal1 = Format(dblTotal, "0.00")
End Sub
Private Function GetPrice(rng As Range, strProduct As String) As Double
On Error GoTo ErrorHandler
GetPrice = WorksheetFunction.VLookup(strProduct, rng, 2, False)
Exit Function
ErrorHandler:
GetPrice = 0
End Function
To trigger this code, you need to insert these events:
Private Sub cbHaribo1_Change()
SetTotal
End Sub
Private Sub cbOldf_Change()
SetTotal
End Sub
Private Sub txtQuantity1_Change()
SetTotal
End Sub
Note that the form is a bit ambiguous - at the moment the code applies to quantity to both, Haribo and Old Favorites. Better you either prodive a second quantity field - or insert an option box that greys out Haribo or Old Favorites...