I would like to change the data values of textboxes by using a spinbutton
The data are written in an Excel table ..... could you explain to me which
syntax I should use or perhaps could you show me an example?
Private Sub SpinButton1_Change()
'Range("G15").Value = SpinButton1.Value
Dim I As Integer
For I = 2 To 10 Step 1
TextBox2.Value = Ws.Range("A"& I)
Next
Using the following code i gives a good result but but why do i need an msgbox ? Without msgbox it doesn't function ... strange ...
Private Sub SpinButton1_Change()
Dim I As Integer
For I = 2 To 10 Step 1
MsgBox ("La valeur de la Textbox" & I & " est de " & TextBox2)
ComboBox1.Value = Ws.Range("A" & I)
ActiveCell = Me.ComboBox1.Value
TextBox2.Value = Ws.Range("B" & I)
TextBox3.Value = Ws.Range("C" & I)
TextBox4.Value = Ws.Range("D" & I)
TextBox5.Value = Ws.Range("E" & I)
TextBox6.Value = Ws.Range("F" & I)
TextBox7.Value = Ws.Range("G" & I)
TextBox8.Value = Ws.Range("H" & I)
TextBox9.Value = Ws.Range("I" & I)
'Range("G15").Value = SpinButton1.Value
Next
Related
I'm trying to get the following vba code to run in excel but keep getting an "Sub or Function not defined" error. I'm hoping someone can help for I'm on a time crunch.
Sub timeFormat2()
Dim timeArray() As Variant
Dim hour As String
Dim min As String
Dim tempMin As String
rTimeCol = "d"
For i = 2 To 5
'Only hour exist
If ((InStr(Range("rTimeCol" & i).Value, "h") > 0) And (InStr(Range("rTimeCol" & i).Value, "m") = 0)) Then
timeArray = Split(Range("rTimeCol" & i).Value, "h")
hour = timeArray(1)
min = "0"
Range("v" & i).Value = Trim(hour)
Range("w" & i).Value = min
Exit For
'Only minutes exist
ElseIf ((InStr(Range("rTimeCol" & i).Value, "h") = 0) And (InStr(Range("rTimeCol" & i).Value, "m") > 0)) Then
'timeArray = Split(Range("rTimeCol" & i).Value, "m")
tempMin = Range("rTimeCol" & i).Value
hour = "0"
min = Right(tempMin, Len(tempMin) - 1)
Range("v" & i).Value = hour
Range("w" & i).Value = Trim(min)
Else 'hour and minutes
'If InStr(Range("e2").Value, "h") > 0 Then
timeArray = Split(Range("rTimeCol" & i).Value, "h")
hour = timeArray(1)
timeArray = Split(Range("rTimeCol" & i).Value, " ")
min = Right(timeArrary(2), Len(timeArray(2)) - 1)
Range("v" & i).Value = Trim(hour)
Range("w" & i).Value = Trim(min)
'Exit For is not necessary with the Else clause
End If
Next cell
End Sub
Assuming your values are like 12m or 10h or 4h 36m then try this;
Sub timeFormat3()
Const COL_TIME = "C"
Dim i As Long
For i = 2 To 5
Cells(i, "V").Resize(1, 2) = hhmm(Cells(i, COL_TIME))
Next
MsgBox "Done"
End Sub
Function hhmm(s As String) As Variant
Dim ar, i As Integer, m As Integer, h As Integer
ar = Split(s, " ")
For i = 0 To UBound(ar)
If InStr(ar(i), "m") Then
m = Replace(ar(i), "m", "")
ElseIf InStr(ar(i), "h") Then
h = Replace(ar(i), "h", "")
End If
Next
hhmm = Array(h, m)
End Function
The following code runs but, not getting the results. The information is there in the correct range.
Dim ID As Range
Dim SN As Range
Dim i As Integer
Set ID = Sheet6.Range("B2:B8")
Set SN = Sheet2.Range("C7:C184")
For i = 2 To ID.Cells.count
If ID.Cells(i) = SN.Cells(i) Then
MsgBox "do something"
ID.Cells.Offset(0, 2).Value = SN.Cells.Offset(0, -2).Value
Else
MsgBox "sorry"
End If
Next
i found another code and modified it to my work sheet. This one works great.
Dim i As Long
Dim j As Long
For i = 2 To 40
If Sheet6.Range("C" & i).Value = "" Then
Exit For
End If
For j = 7 To 1000
If Sheet2.Range("c" & j).Value = "" Then
Exit For
End If
If Sheet6.Range("C" & i).Text = Sheet2.Range("c" & j).Text Then
Sheet6.Range("C" & i).Offset(0, 1).Value = Sheet2.Range("c" & j).Offset(0, -2).Value
Sheet6.Range("C" & i).Offset(0, 2).Value = Sheet2.Range("c" & j).Offset(0, 2).Value
Exit For
End If
Next j
Next i
If Column 2 is equal ChosenDate when the button is clicked, the Label Box in VBA will display all the row data of Column 6. But I can only display one data. and if the value ChosenDate is changed the data diplayed in Label Box will also be changed.
Dim DateChosen As Date
Dim i As Integer
DateChosen = "2020/07/20"
For i = 10 To 5000
If Cells(i, 2).Value = DateChosen Then
EventLabel.Caption = Range("F" & i)
End If
Next i
Try replacing of
EventLabel.Caption = Range("F" & i)
with
EventLabel.Caption = EventLabel.Caption & Range("F" & i) & VbCrLf 'to be displayed one on top of the other
or
EventLabel.Caption = EventLabel.Caption & Range("F" & i) & ", "' to be dsplayed one after the other
Edited:
In order to keep only the last iteration/processing result, your code must previously clear the caption:
EventLabel.Caption = ""
For i = 10 To 5000
If Cells(i, 2).Value = DateChosen Then
EventLabel.Caption = EventLabel.Caption & Range("F" & i) & VbCrLf
End If
Next i
Try below sub.
Sub MultiLineLabel()
Dim DateChosen As Date
Dim i As Integer
Dim myCaption
DateChosen = "2020/07/20"
For i = 10 To 5000
If Cells(i, 2).Value = DateChosen Then
myCaption = myCaption & Range("F" & i) & vbNewLine
End If
Next i
EventLabel.Caption = myCaption
End Sub
I'm trying to build a check in my code, with the user input in a textbox, I'm trying to use a vlookup in previous records in a table to check if that unique value as already been used (initialized).
The target range "erpLots" contains text formatted cells, amd after checking using the VarType() function I know that assigning vValue = SpecEntry.TextBox3.Value vValue is a string type, the error that I'm getting "Type missmatch" is when doing the vlookup If Application.VLookup(vValue, erpLots, 1, False) = SpecEntry.TextBox3.Value Then.
I have a hunch that the error revolves around a type missmatch between the value being searched "vValue" and the target range "erpLots".
Here is the code:
Public intA As Integer
Public foundRow As Double
Sub StartButtonClick()
Dim rowCount As Long
Dim ws As Worksheet
Dim stg As String
Dim erpLots As Range
Dim vValue As Variant
Set erpLots = Worksheets("Inspection Data").Range("C2", Range("C2").End(xlDown))
Set ws = Worksheets("Inspection Data")
rowCount = ws.Range("A111111").End(xlUp).Row
'Checking the userform request info is complete
If Trim(SpecEntry.TextBox1.Value) = vbNullString Then
MsgBox "Please enter Operator ID"
ElseIf Trim(SpecEntry.TextBox2.Value) = vbNullString Then
MsgBox "Please scan or enter spec. number."
ElseIf Trim(SpecEntry.TextBox3.Value) = vbNullString Then
MsgBox "Please scan or enter ERP Lot #."
Else
SpecEntry.TextBox1.Value = UCase(SpecEntry.TextBox1.Value)
SpecEntry.TextBox2.Value = UCase(SpecEntry.TextBox2.Value)
SpecEntry.TextBox3.Value = UCase(SpecEntry.TextBox3.Value)
'checking if ERP Lot # already exist in the list
vValue = SpecEntry.TextBox3.Value
MsgBox "vValue is: " & vValue
If Application.VLookup(vValue, erpLots, 1, False) = SpecEntry.TextBox3.Value Then
foundRow = WorksheetFunction.Match(SpecEntry.TextBox3.Value, erpLots, 1)
Range("G" & foundRow).Value = Now()
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "h:mm"
Range("H" & foundRow).Value = Range("H" & foundRow).Value * 1440
Range("H" & foundRow).NumberFormat = "000.00"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.Count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).Value = SpecEntry.TextBox2.Value
.Offset(rowCount, 2).Value = SpecEntry.TextBox3.Value
.Offset(rowCount, 3).Value = Now()
End With
End If
End If
End Sub
My goal is that if the value exist, the information being captured is to be recorded in the same row but different columns, if the value does not exist, the information would become a new record.
If your Application.match() is working, why not dropthe vloopkup and just:
foundRow = Application.Iferror(WorksheetFunction.Match(SpecEntry.TextBox3.Value, erpLots, 1),0)
Then your If statement is:
If foundRow > 0 Then
Range("G" & foundRow).Value = Now()
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "h:mm"
Range("H" & foundRow).Value = Range("H" & foundRow).Value * 1440
Range("H" & foundRow).NumberFormat = "000.00"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.Count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).Value = SpecEntry.TextBox2.Value
.Offset(rowCount, 2).Value = SpecEntry.TextBox3.Value
.Offset(rowCount, 3).Value = Now()
End With
End If
I went with a countif, as a way to check if the input from the user existed in the target range, and then use that as a condition in the if statement.
Public intA As Integer
Public foundRow As Double
Sub StartButtonClick()
Dim rowCount As Long
Dim ws As Worksheet
Dim stg As String
Dim erpLots As Range
Dim vValue As Variant
Dim count As Integer
Set erpLots = Worksheets("Inspection Data").Range("C2", Range("C2").End(xlDown))
Set ws = Worksheets("Inspection Data")
foundRow = 0
count = 0
rowCount = ws.Range("A111111").End(xlUp).Row
'Checking the userform request info is complete
If Trim(SpecEntry.TextBox1.Value) = vbNullString Then
MsgBox "Please enter Operator ID"
ElseIf Trim(SpecEntry.TextBox2.Value) = vbNullString Then
MsgBox "Please scan or enter spec. number."
ElseIf Trim(SpecEntry.TextBox3.Value) = vbNullString Then
MsgBox "Please scan or enter ERP Lot #."
Else
SpecEntry.TextBox1.Value = UCase(SpecEntry.TextBox1.Value)
SpecEntry.TextBox2.Value = UCase(SpecEntry.TextBox2.Value)
SpecEntry.TextBox3.Value = UCase(SpecEntry.TextBox3.Value)
'checking if ERP Lot # already exist in the list and is coming back from labs
vValue = CStr(Trim(SpecEntry.TextBox3.Value))
count = Application.WorksheetFunction.CountIf(erpLots, vValue)
If count >= 1 Then
foundRow = Application.WorksheetFunction.Match(vValue, erpLots, 0) + 1
MsgBox "row to update is: " & foundRow
Range("G" & foundRow).Value = Now()
Range("G" & foundRow).NumberFormat = "mm/dd/yyyy hh:mm"
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "d " & Chr(34) & "days" & Chr(34) & " , h:mm:ss"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).NumberFormat = "#"
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).NumberFormat = "#"
.Offset(rowCount, 1).Value = CStr(SpecEntry.TextBox2.Value)
.Offset(rowCount, 2).NumberFormat = "#"
.Offset(rowCount, 2).Value = CStr(SpecEntry.TextBox3.Value)
.Offset(rowCount, 3).Value = Now()
End With
End If
End If
End Sub
I have created a userform which would validate if entry is of email format, if it is of directory file format, if all enteries except for the first activity is filled. However when I click submit, the values are not added into excel. Kindly advise me as I am really lost. Thanks.
Private Sub CommandButton1_Click()
Dim tDate As Date
Dim LastRow As Long
Dim strValue As String
Dim msg As String
strValue = TextBox5.Value
LastRow = ActiveSheet.Range("E65536").End(xlUp).Row + 1
If Not (TextBox5.Value = " " And TextBox1.Value = " " And (IsNull(ComboBox1.Value) = True) And (IsNull(ComboBox2.Value) = True) And TextBox6.Value = "" And TextBox4.Value = "" And (IsNull(MonthView1.Value) = True)) Then
With CreateObject("vbscript.regexp")
.Pattern = "^[\w-\.]+#([\w-]+\.)+[A-Za-z]{2,3}$"
If .test(TextBox6.Value) Then
'MsgBox "Added"
GoTo GoToHere
Else
MsgBox "Invalid"
Cancel = True
End If
End With
GoToHere: ElseIf Not (InStr(strValue, "C:\") = 1) Then
MsgBox "Please start your directory with 'C:\'"
Else
ActiveSheet.Range("Q" & LastRow).Value = Me.TextBox5
ActiveSheet.Range("E" & LastRow).Value = Me.TextBox1
'tDate = CDate(TextBox2.Text)
ActiveSheet.Range("G" & LastRow).Value = Me.MonthView1
'Format(tDate, "dd/mm/yy")
ActiveSheet.Range("H" & LastRow).Value = Me.ComboBox1
ActiveSheet.Range("I" & LastRow).Value = Me.TextBox3
ActiveSheet.Range("J" & LastRow).Value = Me.ComboBox2
ActiveSheet.Range("M" & LastRow).Value = Me.TextBox4
ActiveSheet.Range("C" & LastRow).Value = Me.TextBox7
ActiveSheet.Range("S" & LastRow).Value = Me.TextBox6
End If
End Sub
Solved!!! Yeah... Here is my solution.
Private Sub CommandButton1_Click()
Dim tDate As Date
Dim LastRow As Long
Dim strValue As String
Dim msg As String
strValue = TextBox5.Value
LastRow = ActiveSheet.Range("E65536").End(xlUp).Row + 1
If Not (TextBox5.Value = " " And TextBox2.Value = " " And TextBox3.Value = " " And (IsNull(ComboBox1.Value) = True) And (IsNull(ComboBox2.Value) = True) And TextBox4.Value = "" And (IsNull(MonthView1.Value) = True)) Then
'If Not (TextBox6.Value = "") Then
With CreateObject("vbscript.regexp")
.Pattern = "^[\w-\.]+#([\w-]+\.)+[A-Za-z]{2,3}$"
If .test(TextBox4.Value) Then
'MsgBox "Added"
GoTo GoToHere
Else
MsgBox "Invalid"
Cancel = True
End If
End With
GoToHere: If Not (InStr(strValue, "C:\") = 1) Then
MsgBox "Please start your directory with 'C:\'"
Else
ActiveSheet.Range("Q" & LastRow).Value = Me.TextBox4
ActiveSheet.Range("E" & LastRow).Value = Me.TextBox2
'tDate = CDate(TextBox2.Text)
ActiveSheet.Range("G" & LastRow).Value = Me.MonthView1
'Format(tDate, "dd/mm/yy")
ActiveSheet.Range("H" & LastRow).Value = Me.ComboBox1
ActiveSheet.Range("I" & LastRow).Value = Me.TextBox3
ActiveSheet.Range("J" & LastRow).Value = Me.ComboBox2
ActiveSheet.Range("M" & LastRow).Value = Me.TextBox7
ActiveSheet.Range("C" & LastRow).Value = Me.TextBox1
ActiveSheet.Range("S" & LastRow).Value = Me.TextBox5
End If
End If
End Sub