Can you help me to my problem , I want to happen in my program is that when you type a name to textbox in userform like this "Vincent" it will pass to the sheet in the same manner
Private Sub cmdAdd_Click()
If cmdAdd.Caption = "ADD" Then
txtName.Enabled = True: cboAge.Enabled = True:
cmdAdd.Caption = "SAVE": cmdClose.Caption = "CANCEL"
txtName.SetFocus
Else
If txtName.Text = "" Or cboAge.Text = "" Then
MsgBox "Required field(s) missing!", vbCritical, "Message"
Else
For i = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
If LCase(txtName.Text) = Sheet1.Cells(i, 1).Value And _
cboAge.Text = Sheet1.Cells(i, 2).Value Then
MsgBox "Record already exist!", vbExclamation, "Message"
Call UserForm_Activate
Exit Sub
End If
Next i
r = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheet1.Cells(r, 1).Value = (txtName.Text)
Sheet1.Cells(r, 2).Value = cboAge.Text
r = 0
MsgBox "One record saved!", vbInformation, "Message"
Call UserForm_Activate
End If
End If
End Sub
this is the code can you help me ..thank you
Use StrConv to convert to Propercase. See this MSDN Link
Debug.Print StrConv(Textbox1.Text, vbProperCase)
For example (From your code)
Sheet1.Cells(r, 1).Value = StrConv(txtName.Text, vbProperCase)
Related
I have a simple user form that collects informations about persons.
Here an example of what I get when I added informations of 6 persons. I want to start the list of informations from the 3th row (since the 2 first ones are filled by Command button "Remplir formulaire" :
My issue is that I would like, at the calling of userForm, to have 14 headers names for each first 14 columns (the functions to fill the values into these columns will be done later in my code).
To set the names of the 14 fields (starting from row=3), I did :
Private Sub ResetForm()
'Monsieur by default
ComboBox1.Value = "Monsieur"
'Empty TextBox1
TextBox1.Value = ""
'Empty TextBox2
TextBox2.Value = ""
'Empty TextBox3
TextBox3.Value = ""
End Sub
Private Sub UserForm_Initialize()
'Create header for each colum
Dim HeaderName(14) As String
'Index to browse HeaderName array
Dim a As Integer
HeaderName(1) = "Civilité"
HeaderName(2) = "Nom"
HeaderName(3) = "Prénom"
HeaderName(4) = "Âge"
HeaderName(5) = "Fonction"
HeaderName(6) = "Entité"
HeaderName(7) = "Catégorie"
HeaderName(8) = "Adresse"
HeaderName(9) = "Code postal"
HeaderName(10) = "Ville"
HeaderName(11) = "Tél Fixe"
HeaderName(12) = "Tél Portable"
HeaderName(13) = "Email"
HeaderName(14) = "Autres infos"
'Initlialize headers : start from row = 3
Sheet1.Activate
With Sheet1
For a = 1 To 14
If (.Cells(3, a) <> "") Then
.Cells(3, a).Value = HeaderName(a)
End If
Debug.Print "a = " & a
Next a
End With
'Fill ComboBox
With ComboBox1
.AddItem "Monsieur"
.AddItem "Madame"
End With
'Set Elu by default
CheckBox1.Value = True
CheckBox2.Value = False
'Reset all inputs
Call ResetForm
End Sub
and into the same VBA source, I did for Command button" "Remplir Formulaire" :
Private Sub CommandButton1_Click()
Dim emptyRow As Long
Sheet1.Activate
With Sheet1
emptyRow = .UsedRange.Rows.Count + .UsedRange.Rows(1).Row - 1
If .Cells(emptyRow, 1).Value <> "" Then
emptyRow = emptyRow + 1
.Cells(emptyRow, 1).Value = ComboBox1.Value
.Cells(emptyRow, 2).Value = TextBox1.Value
.Cells(emptyRow, 3).Value = TextBox2.Value
.Cells(emptyRow, 4).Value = TextBox3.Value
.Cells(emptyRow, 5).Value = CheckBox1.Value
If CheckBox1.Value = True Then
.Cells(emptyRow, 5).Value = CheckBox1.Caption
Else
.Cells(emptyRow, 5).Value = CheckBox2.Caption
End If
End If
End With
End Sub
So I don't understand why I can't get the 14 names of each top column specified in function UserForm_Initialize() by HeaderName array; only the first four ones (Civilité, Nom, Prénom, Age) are displayed when I click on "Remplir Formulaire" command button, not the 10 others.
What might be wrong here?
Do you really need to check if the cell is empty? I would replace the 20+ lines of code with:
Sheet1.Range("A3").Resize(1, 14).Value = Array("Civilité", "Nom", "Prénom", "Âge", "Fonction", "Entité", "Catégorie", "Adresse", "Code postal", "Ville", "Tél Fixe", "Tél Portable", "Email", "Autres infos")
I am working with a code to update the data in database through userform. Its first part i.e. search data is working fine but second part i.e. update sometime it works fine but sometime it gives runtime error 91
need help
Private Sub cmd_Update_Click()
Application.DisplayAlerts = False
Dim ws As Worksheet
'check for a Name number
If Trim(Me.TextBox_Search_Data.Value) = "" Then
Me.TextBox_Search_Data.SetFocus
MsgBox "Please fill the data in search box"
Exit Sub
End If
Set ws = Worksheets("Employee Data")
With ws
r.Value = Me.TextBox_Search_Data.Value
r.Offset(, 1).Value = Me.TextBox_EmployeeName.Value
r.Offset(, 2).Value = Me.TextBox_FatherHusbandName.Value
r.Offset(, 3).Value = Me.ComboBox_Designation.Value
r.Offset(, 4).Value = Me.ComboBox_Category.Value
Me.TextBox_Search_Data.SetFocus
MsgBox "Data Updated Sucessfully"
'clear the data
Me.TextBox_EmployeeNumber.Value = ""
Me.TextBox_EmployeeName.Value = ""
Me.TextBox_FatherHusbandName.Value = ""
Me.ComboBox_Designation.Value = ""
Me.ComboBox_Category.Value = ""
End With
End Sub
It looks like the sheet may not be getting set properly, and thus it can't use the object in order to update. See modified code below:
Private Sub cmd_Update_Click()
Application.DisplayAlerts = False
Dim ws As Worksheet
'check for a Name number
If Trim(Me.TextBox_Search_Data.Value) = "" Then
Me.TextBox_Search_Data.SetFocus
MsgBox "Please fill the data in search box"
Exit Sub
End If
' Change ThisWorkbook to a different workbook variable as needed.
Set ws = ThisWorkbook.Worksheets("Employee Data")
If Not ws Is Nothing Then
If not r is Nothing Then
With r
.Value = Me.TextBox_Search_Data.Value
.Offset(, 1).Value = Me.TextBox_EmployeeName.Value
.Offset(, 2).Value = Me.TextBox_FatherHusbandName.Value
.Offset(, 3).Value = Me.ComboBox_Designation.Value
.Offset(, 4).Value = Me.ComboBox_Category.Value
End With
Else
'This will run if r is not set to a range.
End If
Else
'This will occur if the sheet isn't set properly.
End If
Me.TextBox_Search_Data.SetFocus
MsgBox "Data Updated Sucessfully"
'clear the data
Me.TextBox_EmployeeNumber.Value = ""
Me.TextBox_EmployeeName.Value = ""
Me.TextBox_FatherHusbandName.Value = ""
Me.ComboBox_Designation.Value = ""
Me.ComboBox_Category.Value = ""
End Sub
I am trying to add to the next empty cells to the right, the data from the user form text box, if data already exists. Meaning if "E1" is has date, add to "F1" and so on, but only is the range "E1:S1".
Here is a screenshot of the report:
And here is what I've got so far (but it stops as E1):
Private Sub CommandButton1_Click()
If Range("E1") = "" Then Range("E1") = UserForm2.TextBox1.Value Else
Range("E1").End(xlToRight) = UserForm2.TextBox1.Value
If Range("E2") = "" Then Range("E2") = UserForm2.TextBox2.Value Else
Range("E2").End(xlToRight) = UserForm2.TextBox2.Value
End Sub
The End(xlToRight is only going to the end of the populated cells not the next open one. You need to move one more column over after finding the last populated cell. Use Cells() and I prefere staring at the furthest column and coming back.
Private Sub CommandButton1_Click()
If Range("E1").Value = "" Then Range("E1").Value = UserForm2.TextBox1.Value Else
Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1).Value = UserForm2.TextBox1.Value
If Range("E2").Value = "" Then Range("E2").Value = UserForm2.TextBox2.Value Else
Cells(2, Cells(2, Columns.Count).End(xlToLeft).Column + 1).Value = UserForm2.TextBox2.Value
End Sub
I am trying to add a color-filling code into a worksheet_change private sub to highlight the cell where date value has been changed. This macro also updated the referenced database after any change has been made in date column (Column 1 or A). Here is the code:
Private Sub Worksheet_Change(ByVal Target As Range)
If strChk = "Don't Change Yet" Then Exit Sub
Dim r As Integer, c As Integer
r = Target.Row
c = Target.Column
If openMode = True Then Exit Sub
If Trim(Cells(Target.Row, 1)) = "" Then Exit Sub
If r = 2 Then Exit Sub
If r = 3 Then Exit Sub
If Not c = 1 Then Exit Su
If Not IsNumeric(Cells(Target.Row, 2)) Then
MsgBox "no orca number"
Exit Sub
End If
If Not IsDate(Cells(Target.Row, 1)) Then
MsgBox "Target date is invalid! Weird, right?"
Exit Sub
End If
Dim strsqla As String
strsqla = "select target_date, orca, cow from orca " & _
"where orca_id = " & Cells(Target.Row, 2)
Dim adoSQLcon As ADODB.Connection
Set adoSQLcon = New ADODB.Connection
adoSQLcon.Open "Provider=SQLOLEDB;Persist Security Info=False;Integrated Security=SSPI;Initial Catalog=ENV_AC_Nording_dw_DEV;Data Source=S0662K806"
Dim adoSQLRst As ADODB.Recordset
Set adoSQLRst = New ADODB.Recordset
adoSQLRst.Open strsqla, adoSQLcon, adOpenStatic, adLockOptimistic
If adoSQLRst.RecordCount > 0 Then
If IsDate(Target.Value) Then
adoSQLRst!target_date = Cells(Target.Row, 1).Value
MsgBox "Date Updated"
End If
If Not Cells(Target.Row, 4).Value = "" Then
adoSQLRst!ORCA = Cells(Target.Row, 4).Value
MsgBox "ORCA Description Updated"
End If
If Not Cells(Target.Row, 8).Value = "" Then
adoSQLRst!COW = Cells(Target.Row, 8).Value
MsgBox "CoW Devices Updated"
End If
adoSQLRst.Update
End If
adoSQLRst.Close
Set adoSQLRst = Nothing
adoSQLcon.Close
Set adoSQLcon = Nothing
Cells(Target.Row, 1).Interior.Color = RGB(255, 255, 0)
End Sub
So the code I added is "Cells(Target.Row, 1).Interior.Color = RGB(255, 255, 0)". So I want to highlight the cell after changed. But it ended up with this Run-time error '1004':Application-defined or object-defined error. So I was wondering if anyone could help me with this. Cuz I have tried all different types of color-filling codes I can find from website but all of them generated this error.
Thank you very much for any help could provide.
First replace:
If Not c = 1 Then Exit Su
with
If Not c = 1 Then Exit Sub
There may be other problems.
try to use Cells(Target.Range.Row, 1).Interior.Color = RGB(255, 255, 0)
I am not sure it will work but this is how I used it in my own script.
I'm still a Noob when it comes to VBA, but I'm gradually picking it up as I go along. I need help trying to get my simple Flexitime input form to log flexi time "taken" as negative time (-01:00) on a spreadsheet, but I'm not sure how to go about doing it.
This is what I've got so far:
Private Sub submit_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim irow As Long
Set wb = FlexBook
Set ws = FlexBook.Worksheets("Flex Data")
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
If Trim(Me.employee.Value) = "" Then
Me.employee.SetFocus
MsgBox "Please select a name"
Exit Sub
End If
If Trim(Me.owta.Value) = "" Then
Me.owta.SetFocus
MsgBox "Please select whether it is time taken or time owed"
Exit Sub
End If
If Trim(Me.Time.Value) = "" Then
Me.Time.SetFocus
MsgBox "Please input the amount of time"
Exit Sub
End If
If Trim(Me.dateflex.Value) = "" Then
Me.dateflex.SetFocus
MsgBox "Please input the date the flex was owed or taken"
Exit Sub
End If
If Trim(Me.author.Value) = "" Then
Me.author.SetFocus
MsgBox "Please confirm who has authorised this"
Exit Sub
End If
If Trim(Me.owta.Value) = "Owed" Then
Time = Time
ElseIf Trim(Me.owta.Value) = "Taken" Then
Time = Time * -1
Exit Sub
End If
'Insert data in to the table
ws.Cells(irow, 1).Value = Me.employee.Value
ws.Cells(irow, 2).Value = Me.owta.Value
'ws.Cells(irow, 3).Value = ? <---cell to indicate positive or negative time
ws.Cells(irow, 4).Value = CDate(Me.dateflex.Value)
ws.Cells(irow, 5).Value = Me.author.Value
'clear the data
Me.employee.Value = ""
Me.owta.Value = ""
Me.Time.Value = ""
Me.dateflex.Value = ""
Me.author.Value = ""
Me.employee.SetFocus
End Sub
You could use an instant If, an If block, or a Select Case - your choice:
ws.Cells(irow, 3).Value = IIf(Trim(Me.owta.Value) = "Owed", "+", "-")
'// However I wouldn't advise this if you want to evaluate "Owed" and "Taken" seperately.
or
If Trim(Me.owta.Value) = "Owed" Then
ws.Cells(irow, 3).Value = "+"
ElseIf Trim(Me.owta.Value) = "Taken" Then
ws.Cells(irow, 3).Value = "-"
End If
or
Select Case Trim(Me.owta.Value)
Case "Owed": ws.Cells(irow, 3).Value = "+"
Case "Taken": ws.Cells(irow, 3).Value = "-"
End Select
All have their own pros and cons, but in the context in which you are using them will show little difference.