I have some textboxes and a button, which when clicked writes the values in the textboxes in a row, here's a screenshot:
And here's the code:
Function theLastRow() As Long
Dim lastRow As Long
lastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
theLastRow = lastRow
End Function
Private Sub button1_Click()
Sheet2.Cells(theLastRow + 1, 5).Value = Comment.Value
'cant be left empty
If (name1.Value <> "" And name2.Value <> "" And szsz.Value <> "" And Sum.Value <> "") Then
Sheet2.Cells(theLastRow + 1, 1).Value = name1.Value
Sheet2.Cells(theLastRow + 1, 2).Value = name2.Value
Sheet2.Cells(theLastRow + 1, 3).Value = szsz.Value
Sheet2.Cells(theLastRow + 1, 4).Value = Sum.Value
End If
End Sub
It almost works how it's supposed to, but not exactly:
Name2, szsz and sum always start one row lower, what's the problem?
Per my comment above, try this.
Private Sub button1_Click()
Dim LastRow As Long
LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
Sheet2.Cells(LastRow + 1, 5).Value = Comment.Value
'cant be left empty
If (name1.Value <> "" And name2.Value <> "" And szsz.Value <> "" And Sum.Value <> "") Then
Sheet2.Cells(LastRow + 1, 1).Value = name1.Value
Sheet2.Cells(LastRow + 1, 2).Value = name2.Value
Sheet2.Cells(LastRow + 1, 3).Value = szsz.Value
Sheet2.Cells(LastRow + 1, 4).Value = Sum.Value
End If
End Sub
Related
I'm new to InkPicture but I like to use it for user to put signature into the form.
I can't seem to save the signature (inkpicture) to the spreadsheet it just inputs it as 0 into the cell I specify.
With UserForm1.InkPicture1.InkEnabled = False Set.Ink
Me.InkPicture1.Ink
.InkEnabled = True End With
lrDep = Sheets("Deploy").Range("A" & Rows.Count).End(xlUp).Row Sheets("Deploy").Cells(lrDep + 1, "A").Value = TBox1.Text Sheets("Deploy").Cells(lrDep + 1, "B").Value = TBox2.Text Sheets("Deploy").Cells(lrDep + 1, "C").Value = TBox3.Text Sheets("Deploy").Cells(lrDep + 1, "D").Value = TBox4.Text
Sheets("Deploy").Cells(lrDep + 1, "G").Value = InkPicture1.Ink
Could someone please help me.
Thank you.
This is not a complete answer but will help you on your way, comment if you have any questions.
First you will have to have a text box on your form that requires the asset ID,
this will have to be amended to match your current form.
Dim RowN As Long
Dim SearchTxt
SearchTxt = TextBox1.Value 'This should be set to the text box name on the form of the asset ID
On Error Resume Next
RowN = Application.WorksheetFunction.Match(SearchTxt, Range("A:A"), 0)
On Error GoTo 0
If RowN > 0 Then
'your code here if matches
MsgBox RowN ' display the row number
Else
'your code here if no match, possibly add new row of data
MsgBox "No match found"
End If
Now you can amend each line of code to use the found row number, for example:
Sheets("Data").Cells("A" & RowN).Value = TextBox1.Txt
If I was creating this form, I would add a search button to check the asset ID and where it finds a match, all the text boxes would then be populated with the current values of the data, these can then be amended before adding back to the sheet.
The following will look for the ID in Column A and if found will use that row to enter the data, this assumes that the ID is stored in TextBox1.Text, amend as required:
Private Sub SB1_Click()
Dim lrREG As Long, lrB As Long, lrDep As Long, lrDis As Long, lrDAT As Long
Dim foundID As Range
Set foundID = Sheets("Data").Range("A:A").Find(What:=TextBox1.Text, Lookat:=xlWhole)
If Not foundID Is Nothing Then
Sheets("Data").Cells(foundID.Row, "A").Value = TextBox1.Text
Sheets("Data").Cells(foundID.Row, "B").Value = TextBox2.Text
Sheets("Data").Cells(foundID.Row, "C").Value = TextBox3.Text
Else
lrDAT = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Data").Cells(lrDAT, "A").Value = TextBox1.Text
Sheets("Data").Cells(lrDAT, "B").Value = TextBox2.Text
Sheets("Data").Cells(lrDAT, "C").Value = TextBox3.Text
End If
lrREG = Sheets("Register").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Register").Cells(lrREG + 1, "A").Value = TextBox1.Text
Sheets("Register").Cells(lrREG + 1, "B").Value = TextBox2.Text
Sheets("Register").Cells(lrREG + 1, "C").Value = TextBox3.Text
lrB = Sheets("Built").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Built").Cells(lrB + 1, "A").Value = TB1.Text
Sheets("Built").Cells(lrB + 1, "B").Value = TB2.Text
Sheets("Built").Cells(lrB + 1, "C").Value = TB3.Text
Sheets("Built").Cells(lrB + 1, "D").Value = TB4.Text
Sheets("Built").Cells(lrB + 1, "E").Value = TB5.Text
Sheets("Built").Cells(lrB + 1, "F").Value = TB6.Text
lrDep = Sheets("Deploy").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Deploy").Cells(lrDep + 1, "A").Value = TBox1.Text
Sheets("Deploy").Cells(lrDep + 1, "B").Value = TBox2.Text
Sheets("Deploy").Cells(lrDep + 1, "C").Value = TBox3.Text
Sheets("Deploy").Cells(lrDep + 1, "D").Value = TBox4.Text
Sheets("Deploy").Cells(lrDep + 1, "E").Value = TBox5.Text
Sheets("Deploy").Cells(lrDep + 1, "F").Value = TBox6.Text
lrDis = Sheets("Dispose").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Dispose").Cells(lrB + 1, "A").Value = TextBo1.Text
Sheets("Dispose").Cells(lrDis + 1, "B").Value = TextBo2.Text
Sheets("Dispose").Cells(lrDis + 1, "C").Value = TextBo3.Text
Sheets("Dispose").Cells(lrDis + 1, "D").Value = TextBo4.Text
Sheets("Dispose").Cells(lrDis + 1, "E").Value = TextBo5.Text
Sheets("Dispose").Cells(lrDis + 1, "F").Value = TextBo6.Text
End Sub
I am organizing a dirty text in an organised table. And this code stops when the cell the marked line is completed. Can you help me to make it continuing the loop?
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim sh7 As Worksheet
Dim CNAME As String
Set sh = Worksheets("Sheet6")
Set sh7 = Worksheets("Sheet7")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For n = 1 To lr
If InStr(1, sh.Cells(n, 1), "CALL:") = 1 Then
CNAME = sh.Cells(n, 7).Value
Ci = sh.Cells(n + 1, 7).Value
Cpd = sh.Cells(n + 1, 7).Value
Else
If InStr(1, sh.Cells(n, 1), "Topic:") = 1 Then
T = sh.Cells(n, 2)
Tpd = sh.Cells(n + 1, 2)
Types = sh.Cells(n + 4, 2)
DM = sh.Cells(n + 5, 2)
D = sh.Cells(n + 5, 4)
OD = sh.Cells(n + 6, 2)
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
sh7.Cells(lr7 + 1, 1).Value = CNAME '********This is the last line it runs.
sh7.Cells(lr7 + 1, 2).Value = Ci
sh7.Cells(lr7 + 1, 3).Value = Cpd
sh7.Cells(lr7 + 1, 4).Value = T
sh7.Cells(lr7 + 1, 5).Value = Tpd
sh7.Cells(lr7 + 1, 6).Value = Types
sh7.Cells(lr7 + 1, 7).Value = DM
sh7.Cells(lr7 + 1, 8).Value = D
sh7.Cells(lr7 + 1, 9).Value = OD
End If
End If
Next n
End Sub
You should get in the habit of defining all variables and supplying a default value.
EDIT:
It seems my original conclusion was incorrect. Upon further inspection I see what might be an issue in your code. Both times where you are trying to get the last row, you are using Rows.Count as a parameter.
Maybe change these
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
To this (note that I use the sheet variable in the first param)
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(sh7.Rows.Count, 1).End(xlUp).Row
I am doing a scanning Barcode system by using form.
This is how the form works:
User will scan the barcode into "Packing QR Code Serial Number".
Form will compare "Packing QR Code Serial Number" with "Part QR Code Serial Number". If same, shows "OK". Then, the last 7 number is choosen out and increase 1; if not, show "NG" and setfocus back to "Packing QR Code Serial Number".
However, Excel showed "Run Time Error 13" and stuck on the +1 formula".
May I know why is this happen? Any mistake on the code ?
Thanks
_____________________________________________________________________________
Private Sub PackingSNTextBox_AfterUpdate()
Dim emptyRow As Long, Temp1 As String, Temp1A As Long, Temp1B As String, Temp2 As String, Temp11 As Long, Temp1AA As String, Temp3 As String
'Make Sheet1 active
Sheet1.Activate
PartSNTextBox.Enabled = True
If PartSNTextBox.Value = PackingSNTextBox.Value Then
Label8.BackColor = vbGreen
Temp1 = Right(PackingSNTextBox.Value, 7)
Temp11 = CLng(Temp1)
Temp1A = Temp11 + 1
Temp1AA = CStr(Temp1A)
Temp1B = Right("0000000" & Temp1AA, 7)
Temp3 = Left(PackingSNTextBox.Value, 9)
Temp2 = Temp3 & Temp1B
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = Label13
Cells(emptyRow, 2).Value = Label14
Cells(emptyRow, 3).Value = Now
Cells(emptyRow, 4).Value = PartSNTextBox.Value
Cells(emptyRow, 5).Value = PackingSNTextBox.Value
NextSNTextBox.Value = Temp2
Cells(emptyRow, 8).Value = Temp2
PartSNTextBox.Value = ""
PackingSNTextBox.Value = ""
PartSNTextBox.SetFocus
Else
ClearButton.Enabled = False
Label9.BackColor = vbRed
MsgBox ("Wrong Pairing")
PackingSNTextBox = ""
PackingSNTextBox.SetFocus
End If
End Sub
The AfterUpdate event fires before the control's value is changed. Use the Change() event instead.
Here is my simple test:
Private Sub PackingSNTextBox_AfterUpdate()
lblPackingSNTextBox_AfterUpdate.Caption = "PackingSNTextBox_AfterUpdate: " & PartSNTextBox.Value
End Sub
Private Sub PartSNTextBox_Change()
lblPartSNTextBox_Change.Caption = "PartSNTextBox_Change: " & PartSNTextBox.Value
End Sub
Private Sub PartSNTextBox_Change()
Dim Temp1 As String, Temp1A As Long, Temp1B As String, Temp2 As String, Temp11 As Long, Temp1AA As String, Temp3 As String
PartSNTextBox.Enabled = True
If PartSNTextBox.Value = PackingSNTextBox.Value Then
Label8.BackColor = vbGreen
Temp1 = Right(PackingSNTextBox.Value, 7)
Temp11 = getNumbersFromString(Temp1)
Temp1A = Temp11 + 1
Temp1AA = CStr(Temp1A)
Temp1B = Right("0000000" & Temp1AA, 7)
Temp3 = Left(PackingSNTextBox.Value, 9)
Temp2 = Temp3 & Temp1B
With Sheet1
With .Range("A" & .Rows.Count).Offset(1)
'Transfer information
.Value = Label13
.Offset(0, 1).Value = Label14
.Offset(0, 2).Value = Now
.Offset(0, 3).Value = PartSNTextBox.Value
.Offset(0, 4).Value = PackingSNTextBox.Value
End With
End With
NextSNTextBox.Value = Temp2
Cells(emptyRow, 8).Value = Temp2
PartSNTextBox.Value = ""
PackingSNTextBox.Value = ""
PartSNTextBox.SetFocus
Else
ClearButton.Enabled = False
Label9.BackColor = vbRed
MsgBox ("Wrong Pairing")
PackingSNTextBox = ""
PackingSNTextBox.SetFocus
End If
End Sub
Function getNumbersFromString(text As String) As Single
Dim result As String
Dim i As Long
For i = 1 To Len(text)
If Mid(text, i, 1) Like "[1-9.,]" Then result = result & Mid(text, i, 1)
Next
If Len(result) > 0 Then getNumbersFromString = CSng(s)
End Function
i need some help with search function with this, how can i convert this that userform will search other sheet of my workbook
name of other sheet is "DataSource"
im planning to separate the data into another sheet of workbook then define a name and i will make it as offset so inshort whenever i put another data it will be able to search with the use of my search userform
This is my code
Sub GetData()
Dim id As Integer, i As Integer, j As Integer, flag As Boolean
If IsNumeric(UserForm1.TextBox1.Value) Then
flag = False
i = 0
id = UserForm1.TextBox1.Value
Do While Cells(i + 1, 1).Value <> ""
If Cells(i + 1, 1).Value = id Then
flag = True
For j = 2 To 3
UserForm1.Controls("TextBox" & j).Value = Cells(i + 1, j).Value
Next j
End If
i = i + 1
Loop
If flag = False Then
For j = 2 To 3
UserForm1.Controls("TextBox" & j).Value = ""
Next j
End If
Else
ClearForm
End If
End Sub
This is my code for editing data
Sub EditAdd()
Dim emptyRow As Long
If UserForm1.TextBox1.Value <> "" Then
flag = False
i = 0
id = UserForm1.TextBox1.Value
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Do While Cells(i + 1, 1).Value <> ""
If Cells(i + 1, 1).Value = id Then
flag = True
For j = 2 To 3
Cells(i + 1, j).Value = UserForm1.Controls("TextBox" & j).Value
Next j
End If
i = i + 1
Loop
If flag = False Then
For j = 1 To 3
Cells(emptyRow, j).Value = UserForm1.Controls("TextBox" & j).Value
Next j
End If
End If
End Sub
This is defined name of Datasource sheet
Name: data
=OFFSET(DataSource!$A:$A,1,0,COUNTA(DataSource!$A:$A)-1,1)
I have a worksheet called "Data" which stores 9 columns of address fields. The sheet is locked to prevent accidental deletion of cells. All amendments have to be carried out using a Userform
This sub defines the data range:
Private Sub UserForm_Initialize()
Dim LastRow as Long
LastRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Data").Range("A1:I" & LastRow).Name = "ListName"
ComboBox1.RowSource = "ListName"
ComboBox1.ListIndex = 0
End Sub
The next sub changes the form contents when Combobox 1 is changed:
Private Sub ComboBox1_Change()
With ComboBox1
TextBox30.Value = Range(.RowSource).Cells(.ListIndex + 1, 1)
TextBox31.Value = Range(.RowSource).Cells(.ListIndex + 1, 2)
TextBox32.Value = Range(.RowSource).Cells(.ListIndex + 1, 3)
TextBox33.Value = Range(.RowSource).Cells(.ListIndex + 1, 4)
TextBox34.Value = Range(.RowSource).Cells(.ListIndex + 1, 5)
TextBox35.Value = Range(.RowSource).Cells(.ListIndex + 1, 6)
TextBox36.Value = Range(.RowSource).Cells(.ListIndex + 1, 7)
TextBox37.Value = Range(.RowSource).Cells(.ListIndex + 1, 8)
TextBox38.Value = Range(.RowSource).Cells(.ListIndex + 1, 9)
End With
End Sub
The last sub should replace the worksheet contents with the value of the textboxes on the form
Sub CommandButton4_Click()
With ComboBox1
Range(.RowSource).Cells(.ListIndex + 1, 1).Value = TextBox30.Value
Range(.RowSource).Cells(.ListIndex + 1, 2).Value = TextBox31.Value '
Range(.RowSource).Cells(.ListIndex + 1, 3).Value = TextBox32.Value
Range(.RowSource).Cells(.ListIndex + 1, 3).Value = TextBox32.Value
Range(.RowSource).Cells(.ListIndex + 1, 4).Value = TextBox33.Value
Range(.RowSource).Cells(.ListIndex + 1, 5).Value = TextBox34.Value
Range(.RowSource).Cells(.ListIndex + 1, 6).Value = TextBox35.Value
Range(.RowSource).Cells(.ListIndex + 1, 7).Value = TextBox36.Value
Range(.RowSource).Cells(.ListIndex + 1, 8).Value = TextBox37.Value
Range(.RowSource).Cells(.ListIndex + 1, 9).Value = TextBox38.Value
End With
Unload UserForm5
End Sub
The first line (Range(.RowSource).Cells(.ListIndex + 1, 1).Value = TextBox30.Value) is executed in the sub above and the amended value of Textbox30 is pasted on the Data sheet in column A, overwriting the previous value. None of the lines after this are executed. I've even tried moving lines around and each time only the first line is processed.
Can anyone enlighten me as to where I've gone wrong please.
Your control is bound to the range. When you change the range, your control changes, which will trigger its change event, overwriting your textbox values. I suggest you don't use Rowsource at all, but use List to populate the control and then write back to the range using its name:
Private Sub UserForm_Initialize()
Dim LastRow as Long
LastRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Data").Range("A1:I" & LastRow).Name = "ListName"
ComboBox1.List= Sheets("Data").Range("ListName").Value
ComboBox1.ListIndex = 0
End Sub
Private Sub ComboBox1_Change()
Dim lIndex as Long
lIndex = ComboBox1.ListIndex + 1
With Sheets("Data").Range("ListName")
TextBox30.Value = .Cells(lIndex, 1).Value
TextBox31.Value = .Cells(lIndex, 2).Value
TextBox32.Value = .Cells(lIndex, 3).Value
TextBox33.Value = .Cells(lIndex, 4).Value
TextBox34.Value = .Cells(lIndex, 5).Value
TextBox35.Value = .Cells(lIndex, 6).Value
TextBox36.Value = .Cells(lIndex, 7).Value
TextBox37.Value = .Cells(lIndex, 8).Value
TextBox38.Value = .Cells(lIndex, 9).Value
End With
End Sub
Sub CommandButton4_Click()
Dim lIndex as Long
lIndex = ComboBox1.ListIndex + 1
Sheets("Data").Range("ListName").Cells(lIndex, 1).Resize(, 9).Value = _
Array(TextBox30.Value, TextBox31.Value, TextBox32.Value, TextBox32.Value, TextBox33.Value, _
TextBox34.Value, TextBox35.Value, TextBox36.Value, TextBox37.Value, TextBox38.Value)
Unload Me
End Sub