I have an Excel (365) spreadsheet with two Comboboxes - Combobox1 and Combobox2 both are used to list the same data for different purposes on different tabs. My problem is that although I have changed listrows in both to the same number (20) only Combobox2 shows 20 rows. Combobox1 only shows the previous number of rows (15) although set to display 20. Anyone know how to get it to behave properly?
EDIT I have solved my origional problem but I would however be interested in using VBA to automatically update both listfillrange and listrows when a new row of data is added. I do have a macro that I use to add new data to my data table that could be adapted to also update listfillrange and listrows
Sub add_to_table_sa_3()
'Written by Keith Cooper 27/10/2021
Dim NewRow As Integer
NewRow = Worksheets("input").Range("E1").Value + 1
If Worksheets("input").Range("F1").Value <> 0 Then
MsgBox "There are errors. No data has been added!", vbOKOnly, "Warning!"
Exit Sub
End If
Worksheets("Data").Cells(NewRow, 1).Value = Worksheets("input").Range("B3").Value
Worksheets("Data").Cells(NewRow, 2).Value = Worksheets("input").Range("B4").Value
Worksheets("Data").Cells(NewRow, 3).Value = Worksheets("input").Range("B5").Value
Worksheets("Data").Cells(NewRow, 4).Value = Worksheets("input").Range("B6").Value
Worksheets("Data").Cells(NewRow, 5).Value = Worksheets("input").Range("B7").Value
Worksheets("Data").Cells(NewRow, 6).Value = Worksheets("input").Range("B8").Value
Worksheets("Data").Cells(NewRow, 7).Value = Worksheets("input").Range("B9").Value
Worksheets("Data").Cells(NewRow, 8).Value = Worksheets("input").Range("B10").Value
Worksheets("Data").Cells(NewRow, 9).Value = Worksheets("input").Range("B11").Value
Worksheets("Data").Cells(NewRow, 10).Value = Worksheets("input").Range("B12").Value
Worksheets("Data").Cells(NewRow, 11).Value = Worksheets("input").Range("B13").Value
Worksheets("Data").Cells(NewRow, 12).Value = Worksheets("input").Range("B14").Value
Worksheets("Data").Cells(NewRow, 13).Value = Worksheets("input").Range("B15").Value
Worksheets("Data").Cells(NewRow, 14).Value = Worksheets("input").Range("B16").Value
Worksheets("Data").Cells(NewRow, 15).Value = Worksheets("input").Range("B17").Value
Worksheets("Data").Cells(NewRow, 16).Value = Worksheets("input").Range("B18").Value
Worksheets("Data").Cells(NewRow, 17).Value = Worksheets("input").Range("B19").Value
Worksheets("Data").Cells(NewRow, 18).Value = Worksheets("input").Range("B20").Value
Worksheets("Data").Cells(NewRow, 19).Value = Worksheets("input").Range("B21").Value
Worksheets("Data").Cells(NewRow, 20).Value = Worksheets("input").Range("B22").Value
Worksheets("Data").Cells(NewRow, 21).Value = Worksheets("input").Range("B23").Value
Worksheets("Data").Cells(NewRow, 22).Value = Worksheets("input").Range("B24").Value
Worksheets("Data").Cells(NewRow, 23).Value = Worksheets("input").Range("B25").Value
Worksheets("Data").Cells(NewRow, 24).Value = Worksheets("input").Range("B26").Value
Worksheets("Data").Cells(NewRow, 25).Value = Worksheets("input").Range("B27").Value
Worksheets("Data").Cells(NewRow, 26).Value = Worksheets("input").Range("B28").Value
Worksheets("Data").Cells(NewRow, 27).Value = Worksheets("input").Range("B29").Value
Worksheets("Data").Cells(NewRow, 28).Value = Worksheets("input").Range("B30").Value
Worksheets("Data").Cells(NewRow, 29).Value = Worksheets("input").Range("B31").Value
Worksheets("Data").Cells(NewRow, 30).Value = Worksheets("input").Range("B32").Value
Worksheets("Data").Cells(NewRow, 31).Value = Worksheets("input").Range("B33").Value
Worksheets("Data").Cells(NewRow, 32).Value = Worksheets("input").Range("B34").Value
Worksheets("Data").Cells(NewRow, 33).Value = Worksheets("input").Range("B35").Value
Worksheets("Data").Cells(NewRow, 34).Value = Worksheets("input").Range("B36").Value
Worksheets("Data").Cells(NewRow, 35).Value = Worksheets("input").Range("B37").Value
'Range("B38") is a heading
Worksheets("Data").Cells(NewRow, 36).Value = Worksheets("input").Range("B39").Value
Worksheets("Data").Cells(NewRow, 37).Value = Worksheets("input").Range("B40").Value
Worksheets("Data").Cells(NewRow, 38).Value = Worksheets("input").Range("B41").Value
Worksheets("Data").Cells(NewRow, 39).Value = Worksheets("input").Range("B42").Value
Worksheets("Data").Cells(NewRow, 40).Value = Worksheets("input").Range("B43").Value
Worksheets("Data").Cells(NewRow, 41).Value = Worksheets("input").Range("B44").Value
Worksheets("Data").Cells(NewRow, 42).Value = Worksheets("input").Range("B45").Value
Worksheets("Data").Cells(NewRow, 43).Value = Worksheets("input").Range("B46").Value
Worksheets("Data").Cells(NewRow, 44).Value = Worksheets("input").Range("B47").Value
Worksheets("Data").Cells(NewRow, 45).Value = Worksheets("input").Range("B48").Value
Worksheets("Data").Cells(NewRow, 46).Value = Worksheets("input").Range("B49").Value
Worksheets("Data").Cells(NewRow, 47).Value = Worksheets("input").Range("B50").Value
Worksheets("Data").Cells(NewRow, 48).Value = Worksheets("input").Range("B51").Value
Worksheets("Data").Cells(NewRow, 49).Value = Worksheets("input").Range("B52").Value
Worksheets("Data").Cells(NewRow, 50).Value = Worksheets("input").Range("B53").Value
Worksheets("Data").Cells(NewRow, 51).Value = Worksheets("input").Range("B54").Value
Worksheets("Data").Cells(NewRow, 52).Value = Worksheets("input").Range("B55").Value
Sheets("Input").Select
Range("C2").Value = "Data added"
MsgBox "Data added", vbOKOnly, "Transfer Data"
Worksheets("input").Range("E1").Value = NewRow
Worksheets("input").Range("B3").Select
End Sub
Consider replacing the 52 lines transposing the data with one line inside a For/Next loop
Option Explicit
Sub add_to_table_sa_3()
Dim NewRow As Long, i as Long, arData
With Sheets("Input")
If .Range("F1").Value <> 0 Then
MsgBox "There are errors. No data has been added!", vbOKOnly, "Warning!"
Exit Sub
End If
arData = .Range("B3:B55").Value
NewRow = .Range("E1").Value + 1
End With
With Sheets("Data")
For i = 1 To 35
.Cells(NewRow, i) = arData(i, 1)
Next
'Range("B38") is a heading
For i = 37 To 65
.Cells(NewRow, i - 1) = arData(i, 1)
Next
'Range("B68") is a heading
For i = 67 To UBound(arData)
.Cells(NewRow, i - 2) = arData(i, 1)
Next
Sheet1.ComboBox1.ListFillRange = "'" & .Name & "'!A2:A" & NewRow
Sheet6.ComboBox2.ListFillRange = "'" & .Name & "'!A2:A" & NewRow
End With
With Sheets("Input")
.Range("C2").Value = "Data added"
.Range("E1").Value = NewRow
.Activate
.Range("B3").Select
End With
MsgBox "Data added row " & NewRow, vbOKOnly, "Transfer Data"
End Sub
Related
Hi and thanks in advance I am new to excel vba and need help on some little problem
I receive an adhoc task from my boss to using excel vba to compile report. This task need 2 workbook to be using. 1 is source workbook: Product.xlsx and another one is targeted workboook:Report Template.xlsx
What I need to do is if all the criteria input in the userform is found in the source workbook it will copy all the related data. I managed to do so but the problem is the column index is set by me, I need help on this if there is a way to replace this column index by using looping or another way to do so.
The source workbook contain enourmous row of data and about 54 columns. The data need to be pasted on the targeted workbook is need to exclude some columns in the source workbook. Here is my code:
Dim LastRow As Long
Dim i As Long
Dim erow As Long
Dim wbk As Workbook
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Dim Fab, Test As String
Dim Machine, Year, WW As String
Fab = FabTextBox.Text
Year = YearComboBox.Text
WW = WWComboBox.Text
Test = TestTypeComboBox.Text
Set SourceSheet = ActiveSheet
With SourceSheet
LastRow = .Range("A4").SpecialCells(xlCellTypeLastCell).Row
If Test = "Test A" Then
Set wbk = Workbooks.Open("Report Template1.xlsx")
Set DestSheet = wbk.Sheets("Cover")
Else
Set wbk = Workbooks.Open("Report Template2.xlsx")
Set DestSheet = wbk.Sheets("Cover")
End If
With DestSheet
.Columns(3).NumberFormat = "hh:mm:ss AM/PM"
End With
For i = 2 To LastRow
If SourceSheet.Cells(i, 4).Value = Fab Then
If SourceSheet.Cells(i, 6).Value = Year Then
If SourceSheet.Cells(i, 7).Value = WW Then
If SourceSheet.Cells(i, 9).Value = Test Then
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'change the column numbers to the relevant number
DestSheet.Cells(erow, 1).Value = SourceSheet.Cells(i, 2).Value
DestSheet.Cells(erow, 2).Value = SourceSheet.Cells(i, 10).Value
DestSheet.Cells(erow, 3).Value = SourceSheet.Cells(i, 11).Value
DestSheet.Cells(erow, 4).Value = SourceSheet.Cells(i, 12).Value
DestSheet.Cells(erow, 5).Value = SourceSheet.Cells(i, 13).Value
DestSheet.Cells(erow, 6).Value = SourceSheet.Cells(i, 14).Value
DestSheet.Cells(erow, 7).Value = SourceSheet.Cells(i, 15).Value
DestSheet.Cells(erow, 8).Value = SourceSheet.Cells(i, 16).Value
DestSheet.Cells(erow, 9).Value = SourceSheet.Cells(i, 17).Value
DestSheet.Cells(erow, 10).Value = SourceSheet.Cells(i, 18).Value
DestSheet.Cells(erow, 11).Value = SourceSheet.Cells(i, 19).Value
DestSheet.Cells(erow, 12).Value = SourceSheet.Cells(i, 20).Value
DestSheet.Cells(erow, 13).Value = SourceSheet.Cells(i, 21).Value
DestSheet.Cells(erow, 14).Value = SourceSheet.Cells(i, 22).Value
DestSheet.Cells(erow, 15).Value = SourceSheet.Cells(i, 23).Value
DestSheet.Cells(erow, 16).Value = SourceSheet.Cells(i, 24).Value
DestSheet.Cells(erow, 17).Value = SourceSheet.Cells(i, 25).Value
DestSheet.Cells(erow, 18).Value = SourceSheet.Cells(i, 26).Value
DestSheet.Cells(erow, 19).Value = SourceSheet.Cells(i, 27).Value
DestSheet.Cells(erow, 20).Value = SourceSheet.Cells(i, 28).Value
DestSheet.Cells(erow, 21).Value = SourceSheet.Cells(i, 29).Value
DestSheet.Cells(erow, 22).Value = SourceSheet.Cells(i, 30).Value
DestSheet.Cells(erow, 23).Value = SourceSheet.Cells(i, 31).Value
DestSheet.Cells(erow, 24).Value = SourceSheet.Cells(i, 32).Value
DestSheet.Cells(erow, 25).Value = SourceSheet.Cells(i, 33).Value
DestSheet.Cells(erow, 26).Value = SourceSheet.Cells(i, 34).Value
DestSheet.Cells(erow, 27).Value = SourceSheet.Cells(i, 35).Value
DestSheet.Cells(erow, 28).Value = SourceSheet.Cells(i, 36).Value
DestSheet.Cells(erow, 29).Value = SourceSheet.Cells(i, 37).Value
DestSheet.Cells(erow, 30).Value = SourceSheet.Cells(i, 38).Value
DestSheet.Cells(erow, 31).Value = SourceSheet.Cells(i, 39).Value
DestSheet.Cells(erow, 32).Value = SourceSheet.Cells(i, 40).Value
DestSheet.Cells(erow, 33).Value = SourceSheet.Cells(i, 41).Value
DestSheet.Cells(erow, 34).Value = SourceSheet.Cells(i, 42).Value
DestSheet.Cells(erow, 35).Value = SourceSheet.Cells(i, 43).Value
DestSheet.Cells(erow, 36).Value = SourceSheet.Cells(i, 44).Value
DestSheet.Cells(erow, 37).Value = SourceSheet.Cells(i, 45).Value
DestSheet.Cells(erow, 38).Value = SourceSheet.Cells(i, 46).Value
DestSheet.Cells(erow, 39).Value = SourceSheet.Cells(i, 47).Value
DestSheet.Cells(erow, 40).Value = SourceSheet.Cells(i, 48).Value
DestSheet.Cells(erow, 41).Value = SourceSheet.Cells(i, 49).Value
DestSheet.Cells(erow, 42).Value = SourceSheet.Cells(i, 50).Value
DestSheet.Cells(erow, 43).Value = SourceSheet.Cells(i, 51).Value
DestSheet.Cells(erow, 44).Value = SourceSheet.Cells(i, 52).Value
DestSheet.Cells(erow, 45).Value = SourceSheet.Cells(i, 53).Value
DestSheet.Cells(erow, 46).Value = SourceSheet.Cells(i, 54).Value
End If
End If
End If
End If
Next i
And because i know how many columns in the data set I tried to replace my code as shown belows but it does not copy as code above.this code only copy data from SourceSheet.Cells(i, 2).Value
For i = 2 To LastRow
If SourceSheet.Cells(i, 4).Value = Fab Then
If SourceSheet.Cells(i, 6).Value = Year Then
If SourceSheet.Cells(i, 7).Value = WW Then
If SourceSheet.Cells(i, 9).Value = Test Then
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'change the column numbers to the relevant number
DestSheet.Cells(erow, 1).Value = SourceSheet.Cells(i, 2).Value
For j = 2 To 46
For k = 10 To 54
DestSheet.Cells(erow, j).Value = SourceSheet.Cells(i, k).Value
Next k
Next j
End If
End If
End If
End If
Next i
You can copy the data in two operations:
Dim rwSrc as Range
For i = 2 To LastRow
Set rwSrc = SourceSheet.Rows(i)
If rwSrc.Cells(4).Value = Fab Then
If rwSrc.Cells(6).Value = Year Then
If rwSrc.Cells(7).Value = WW Then
If rwSrc.Cells(9).Value = Test Then
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With DestSheet.rows(erow)
.cells(1).Value = rwSrc.Cells(2).Value
'adjust the 50 to match your actual data
.cells(2).Resize(1, 50).Value = rwSrc.Cells(10).Resize(1, 50).Value
End With
End If
End If
End If
End If
Next i
I'm new to VBA and I have the following code.
I want to sum in the variable SumDef the values of all the textboxes in a frame of a userform, if the textbox is not void.
But I get
runtime error 438 : Object doesn't support this property or method
Private Sub CommandButton2_Click()
'PROBLEEEEEM
Dim SumDef As Integer
Dim txt As Control
SumDef = 0
For Each txt In Me.Frame3.Controls
If TypeName(txt) = "TextBox" And IsNumeric(txt.Value) = True Then
SumDef = SumDef + CInt(txt.Text)
End If
Next txt
If TextBox2.Value <> vbNullString And CInt(TextBox2.Text) <= SumDef Then
cell2.Offset(, 7).Value = TextBox2.Text
cell2.Offset(, 19).Value = TextBox3.Text
cell2.Offset(, 8).Value = TextBox4.Text
cell2.Offset(, 9).Value = TextBox5.Text
cell2.Offset(, 10).Value = TextBox6.Text
cell2.Offset(, 11).Value = TextBox7.Text
cell2.Offset(, 12).Value = TextBox8.Text
cell2.Offset(, 13).Value = TextBox9.Text
cell2.Offset(, 14).Value = TextBox10.Text
cell2.Offset(, 15).Value = TextBox11.Text
cell2.Offset(, 16).Value = TextBox12.Text
cell2.Offset(, 17).Value = TextBox13.Text
cell2.Offset(, 18).Value = TextBox14.Text
MsgBox "Bac enregistré avec succes", vbInformation, "ENR FAB 07"
Me.CommandButton3.Enabled = True
Me.CommandButton2.Enabled = False
Else
MsgBox "Nombre de gants défauts est invalide", vbExclamation, "ENR FAB 07"
TextBox2.Value = vbNullString
End If
End Sub
Nest your If statement like this instead as it's trying to evaluate the .Value on all controls otherwise, and not all controls have a .Value property:
If TypeName(txt) = "TextBox" Then
If IsNumeric(txt.Value) = True Then
SumDef = SumDef + CInt(txt.Text)
End If
End If
I am trying to add a button command to save data to ta table in excel. I get Error:9: Subscript out of range. I don't know how to fix it. The data entry sheet in my work book is called "Studies"
Here is the code:
Private Sub CommandButtonSave_Click()
Dim iRow As Long
Dim iCode As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Studies")
'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
iCode = Me.txtcode.Value
'check for a part number
If Trim(Me.txtcode.Value) = "" Then
Me.txtcode.SetFocus
MsgBox "Please enter study"
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txtcode.Value
ws.Cells(iRow, 2).Value = Me.cboreport.Value
ws.Cells(iRow, 3).Value = Me.txttitle.Value
ws.Cells(iRow, 4).Value = Me.cboprincipalinvestigator.Value
ws.Cells(iRow, 5).Value = Me.txtstartdate.Value
ws.Cells(iRow, 6).Value = Me.txtenddate.Value
ws.Cells(iRow, 7).Value = Me.cbotreatment.Value
ws.Cells(iRow, 8).Value = Me.cboSSI.Value
ws.Cells(iRow, 9).Value = Me.cbolotnumber.Value
ws.Cells(iRow, 10).Value = Me.cbodilution.Value
ws.Cells(iRow, 11).Value = Me.cbofrequency.Value
ws.Cells(iRow, 12).Value = Me.cbotmethodofinduction.Value
ws.Cells(iRow, 13).Value = Me.cbostartday.Value
ws.Cells(iRow, 14).Value = Me.cboendday.Value
ws.Cells(iRow, 15).Value = Me.cbodiseasemodel.Value
ws.Cells(iRow, 16).Value = Me.cbodose.Value
ws.Cells(iRow, 17).Value = Me.cbommethodofinduction.Value
ws.Cells(iRow, 18).Value = Me.cbobleedpoints.Value
ws.Cells(iRow, 19).Value = Me.cbotakedownpoints.Value
ws.Cells(iRow, 20).Value = Me.cboimmunecells.Value
ws.Cells(iRow, 21).Value = Me.cbochemotoxins.Value
ws.Cells(iRow, 22).Value = Me.cbocellmarkers.Value
ws.Cells(iRow, 23).Value = Me.cboqpcr.Value
ws.Cells(iRow, 24).Value = Me.cbotissue.Value
ws.Cells(iRow, 25).Value = Me.cboother.Value
ws.Cells(iRow, 26).Value = Me.cbostrain.Value
ws.Cells(iRow, 27).Value = Me.cbosupplier.Value
ws.Cells(iRow, 28).Value = Me.txtdateofbirth.Value
ws.Cells(iRow, 29).Value = Me.txtfindings.Value
ws.Cells(iRow, 30).Value = Me.cbotechnicalissues.Value
ws.Cells(iRow, 31).Value = Me.cbokeyword.Value
ws.Cells(iRow, 32).Value = Me.txtnotes.Value
'clear the data
Me.txtcode.Value = ""
Me.cboreport.Value = ""
Me.txttitle.Value = ""
Me.cboprincipalinvestigator.Value = ""
Me.txtstartdate.Value = ""
Me.txtenddate.Value = ""
Me.cbotreatment.Value = ""
Me.cboSSI.Value = ""
Me.cbolotnumber.Value = ""
Me.cbodilution.Value = ""
Me.cbofrequency.Value = ""
Me.cbotmethodofinduction.Value = ""
Me.cbostartday.Value = ""
Me.cboendday.Value = ""
Me.cbodiseasemodel.Value = ""
Me.cbodose.Value = ""
Me.cbommethodofinduction.Value = ""
Me.cbobleedpoints.Value = ""
Me.cbotakedownpoints.Value = ""
Me.cboimmunecells.Value = ""
Me.cbochemotoxins.Value = ""
Me.cbocellmarkers.Value = ""
Me.cboqpcr.Value = ""
Me.cbotissue.Value = ""
Me.cboother.Value = ""
Me.cbostrain.Value = ""
Me.cbosupplier.Value = ""
Me.txtdateofbirth.Value = ""
Me.txtfindings.Value = ""
Me.cbotechnicalissues.Value = ""
Me.cbokeyword.Value = ""
Me.txtnotes.Value = ""
Me.txtstartdate.Value = Format(Date, "Medium Date")
Me.txtenddate.Value = Format(Date, "Medium Date")
Me.txtdateofbirth.Value = Format(Date, "Medium Date")
Me.txtcode.SetFocus
End Sub
I have a userform for entering the receiving data by the storekeepers, I want to set some mandatory fields for filling in. They are the username, part number and stored location of received file.
I am using the data of my "ref" worksheet for adding items to my combo boxes. and I forced combo box to don't accept any item out of that list. (by using field property "matchrequired" to true).
I have 4 command buttons, done for saving and closing, "add item" for adding a new item to current release note, new release note, which clear the R/N data and would ask for it again, and finally close, which closes the form.
My question is how can I force VBA to check is there any data in the "USER", "P/N" and "Location", and if at least these three field have data, then data entry be possible.
I also want to the code to be able for checking the entry of QTY field and just accepts number (between 1 and 5000 for instance).
Everything is ok with DONE button, but for the two ("add item" and "new release note") stupid errors returns. after msg box showing up the data clears, the combo's items will lost or returns error and so...
I am using "addcmbo" for adding items to combo controls. (Just for user when I am putting that here, the value duplicates in the combo index, and also after message box, the items of this control remains).
If you find any "not good practice" approaches, let me know please.
Sub addcmbo()
Application.ScreenUpdating = False
Sheet2.Activate
' A/C data update
For i = 2 To WorksheetFunction.CountA(Range("b:b"))
If Sheets("Ref").Cells(i, 2) <> "" Then
RCVNG.cmbac.AddItem (Cells(i, 2))
End If
Next
' W/B data update
For i = 2 To WorksheetFunction.CountA(Range("h:h"))
If Sheets("Ref").Cells(i, 8) <> "" Then
RCVNG.Cmbwb.AddItem (Cells(i, 8))
End If
Next
' w/C data update
For i = 2 To WorksheetFunction.CountA(Range("i:i"))
If Sheets("Ref").Cells(i, 9) <> "" Then
RCVNG.Cmbwc.AddItem (Cells(i, 9))
End If
Next
' P/# data update
For i = 2 To WorksheetFunction.CountA(Range("j:j"))
If Sheets("Ref").Cells(i, 10) <> "" Then
RCVNG.Cmbpn.AddItem (Cells(i, 10))
End If
Next
Sheet1.Activate
Application.ScreenUpdating = True
End Sub
Private Sub btnCncl_Click()
Unload Me
End Sub
Private Sub btnadditem_Click()
' Form fields Clear
cmbac.Clear
Cmbwb.Clear
Cmbwc.Clear
Cmbpn.Clear
' cmbac.Value = ""
' Cmbwb.Value = ""
' Cmbwc.Value = ""
' Cmbpn.Value = ""
Txtqty.Value = ""
txtSN.Value = ""
Txtloc.Value = ""
cmnt.Value = ""
' Data entry sufficiency check
If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
MsgBox "Please Fill Required Fields " & Chr(10) & " * User" & Chr(10) & " * Part #" & Chr(10) & " * Location" & Chr(10) & " before Save!"
Call addcmbo
Else:
' Data Entry
Sheet1.Activate
Dim oNewRow As ListRow
ActiveSheet.Cells(1, 3).Select
Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
oNewRow.Range.Cells(1, 7).Value = txtrn.Value
oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
oNewRow.Range.Cells(1, 8).Value = cmbac.Value
oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
oNewRow.Range.Cells(1, 13).Value = txtSN.Value
oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
oNewRow.Range.Cells(1, 16).Value = cmnt.Value
End If
End Sub
Private Sub btndone_Click()
' Data entry sufficiency check
If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
MsgBox "Please Fill Required Fields " & Chr(10) & " * User" & Chr(10) & " * Part #" & Chr(10) & " * Location" & Chr(10) & " before Save!"
Else:
' Data Entry
Sheet1.Activate
ActiveSheet.Cells(1, 3).Select
Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
oNewRow.Range.Cells(1, 7).Value = txtrn.Value
oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
oNewRow.Range.Cells(1, 8).Value = cmbac.Value
oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
oNewRow.Range.Cells(1, 13).Value = txtSN.Value
oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
oNewRow.Range.Cells(1, 16).Value = cmnt.Value
Unload Me
End If
End Sub
Private Sub btnnewrn_Click()
Dim oNewRow As ListRow
' Form fields Clear
txtrn.Value = ""
cmbac.Clear
Cmbwb.Clear
Cmbwc.Clear
Cmbpn.Clear
cmbac.Value = ""
Cmbwb.Value = ""
Cmbwc.Value = ""
Cmbpn.Value = ""
Txtqty.Value = ""
txtSN.Value = ""
Txtloc.Value = ""
cmnt.Value = ""
' Data entry sufficiency check
If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
MsgBox "Please Fill Required Fields " & Chr(10) & " * User" & Chr(10) & " * Part #" & Chr(10) & " * Location" & Chr(10) & " before Save!"
Call addcmbo
Else:
' Data Entry
Sheet1.Activate
ActiveSheet.Cells(1, 3).Select
Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
oNewRow.Range.Cells(1, 7).Value = txtrn.Value
oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
oNewRow.Range.Cells(1, 8).Value = cmbac.Value
oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
oNewRow.Range.Cells(1, 13).Value = txtSN.Value
oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
oNewRow.Range.Cells(1, 16).Value = cmnt.Value
End If
End Sub
Private Sub lblpn_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim pn As String
Application.ScreenUpdating = False
Sheet2.Activate
emptyRow = WorksheetFunction.CountA(Range("j:j")) + 1
pn = inputbox("Type In new ''P/#'' please", "Add NEW P/#")
Cells(emptyRow, 10).Value = pn
RCVNG.Cmbpn.AddItem pn
End Sub
Private Sub lblTeam_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim t As String
Application.ScreenUpdating = False
Sheet2.Activate
emptyRow = WorksheetFunction.CountA(Range("c:c")) + 1
t = inputbox("Type type Your Name Please", "Add name of NEW or Missing team member")
Cells(emptyRow, 3).Value = t
RCVNG.cmbuser.AddItem t
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Sheet2.Activate
DTPicker.SetFocus
DTPicker.Value = Date
' empty fields
shipreceive.Value = ""
txtrn.Value = ""
cmbuser.Clear
cmbac.Clear
Cmbwb.Clear
Cmbwc.Clear
Cmbpn.Clear
Txtqty.Value = ""
txtSN.Value = ""
Txtloc.Value = ""
cmnt.Value = ""
' Combo fields add item
Call addcmbo
' User data update
Application.ScreenUpdating = False
Sheet2.Activate
For i = 2 To WorksheetFunction.CountA(Range("c:c"))
If Sheets("Ref").Cells(i, 3) <> "" Then
RCVNG.cmbuser.AddItem (Cells(i, 3))
End If
Next
Sheet1.Activate
Application.ScreenUpdating = True
End Sub
Thanks a lot, I will appreciate your help
I am trying to put together some codes that I found here and there to build up a small inventory, sales program. I am stuck at a point where the customer basket is finalized and sold items in the basket should be saved in relevant sheets.
As an example,basket data is in sheet1 (A4:g22), needs to be written to sheet2 and sheet3 with finding the first empty cell in column A. Thank you very much for your help in advance.
Private Sub EKSKAYDET_Click()
If Not IsNumeric(Me.eksmiktartxt.Value) Then
MsgBox "Miktari Kontrol Ediniz!"
Me.eksmiktartxt.SetFocus
Exit Sub
End If
If Not IsNumeric(Me.eksreznobox.Value) Then
MsgBox "ÜRÜN KODUNU Kontrol Ediniz!"
Me.eksreznobox.SetFocus
Exit Sub
End If
If eksreznobox.Value = "" Then
MsgBox "ÜRÜN KODU Seçmelisiniz!"
Me.eksreznobox.SetFocus
Exit Sub
End If
If TextBox23 = 0 And TextBox19 = 0 And TextBox20 = 0 And TextBox21 = 0 And TextBox22 = 0 Then
MsgBox "ÖDEME MİKTARI Girmelisiniz!": Exit Sub
Me.TextBox19.SetFocus
End If
If TextBox25.Value = 0 Then
MsgBox "SEPET BOŞ!"
Exit Sub
End If
If TextBox19 = "" And TextBox20 = "" And TextBox21 = "" And TextBox22 = "" And TextBox23 = "" Then
MsgBox "Tutar Girmelisiniz!":
Exit Sub
End If
If eksreznobox.ListCount = 0 Then Exit Sub
ry_bul = eksreznobox.ListIndex + 3
eksadI = Sheets("STOKKARTLARI").Range("D" & ry_bul).Value
EKSSOYADI = Sheets("STOKKARTLARI").Range("E" & ry_bul).Value
textbox12 = Sheets("STOKKARTLARI").Range("h" & ry_bul).Value
TextBox15 = Sheets("STOKKARTLARI").Range("F" & ry_bul).Value
ekstutartxt.Value = eksmiktartxt.Value * textbox12.Value
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("SATISHAREKETLERİ")
lRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
If Trim(Me.eksreznobox.Value) = "" Then
Me.ekreznobox.SetFocus
MsgBox "Lütfen ÜRÜN KODUNU Girin!"
Exit Sub
End If
With ws
.Cells(lRow, 3).Value = Me.eksreznobox.Value
.Cells(lRow, 1).Value = Me.ekstarihtXT.Value
.Cells(lRow, 4).Value = Me.eksadI.Value
.Cells(lRow, 7).Value = Me.eksmiktartxt.Value
.Cells(lRow, 9).Value = Me.ekstutartxt.Value
.Cells(lRow, 8).Value = Me.textbox12.Value
.Cells(lRow, 5).Value = Me.EKSSOYADI.Value
.Cells(lRow, 6).Value = Me.TextBox15.Value
.Cells(lRow, 2).Value = Me.TextBox26.Value
Dim llRow As Long
Dim ws1 As Worksheet
Set ws1 = Worksheets("STOK")
llRow = ws1.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
If Trim(Me.eksreznobox.Value) = "" Then
Me.ekreznobox.SetFocus
MsgBox "Lütfen ÜRÜN KODUNU Girin!"
Exit Sub
End If
With ws1
.Cells(llRow, 3).Value = Me.eksreznobox.Value
.Cells(llRow, 1).Value = Me.ekstarihtXT.Value
.Cells(llRow, 4).Value = Me.eksadI.Value
.Cells(llRow, 7).Value = Me.eksmiktartxt.Value
.Cells(llRow, 9).Value = Me.ekstutartxt.Value
.Cells(llRow, 8).Value = Me.textbox12.Value
.Cells(llRow, 5).Value = Me.EKSSOYADI.Value
.Cells(llRow, 6).Value = Me.TextBox15.Value
.Cells(llRow, 2).Value = Me.TextBox26.Value
.Cells(llRow, 11).Value = Me.TextBox27.Value
ekstutartxt.Value = eksmiktartxt.Value * textbox12.Value
End With
Dim lllRow As Long
Dim ws2 As Worksheet
Set ws2 = Worksheets("kasa")
lllRow = ws2.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
If Trim(Me.eksreznobox.Value) = "" Then
Me.ekreznobox.SetFocus
MsgBox "Lütfen ÜRÜN KODUNU Girin!"
Exit Sub
End If
Me.TextBox52.Value = "SATIŞ"
With ws2
.Cells(lllRow, 1).Value = Me.ekstarihtXT.Value
.Cells(lllRow, 5).Value = Me.TextBox19.Value
.Cells(lllRow, 6).Value = Me.TextBox20.Value
.Cells(lllRow, 7).Value = Me.TextBox21.Value
.Cells(lllRow, 9).Value = Me.TextBox23.Value
.Cells(lllRow, 3).Value = Me.TextBox51.Value
.Cells(lllRow, 2).Value = Me.TextBox26.Value
.Cells(lllRow, 4).Value = Me.TextBox52.Value
ekstutartxt.Value = eksmiktartxt.Value * textbox12.Value
End With
With kayit_formu.ListBox6
.BackColor = vbWhite
.ColumnCount = 9
.ColumnWidths = "50;33;45;55;60;55;42;43;60"
.ForeColor = vbBlack
If Sheets("SATISHAREKETLERİ").Range("A1") = Empty Then
.RowSource = Empty
Else
.RowSource = "SATISHAREKETLERİ!a1:i" & [SATISHAREKETLERİ!A1048500].End(3).Row
End If
End With
MsgBox "Bir Kayit Yapildi!"
End With
Me.TextBox25.Text = CStr(ThisWorkbook.Sheets("SEPET").Range("G1").Value)
Me.TextBox24.Text = CStr(ThisWorkbook.Sheets("SEPET").Range("G2").Value)
End Sub
You can try this code.
Worksheets(“Sheet1″).Range(“A1:G22″).Copy _
Destination:=Worksheets(“Sheet2″).Range(“E5″)