Compile error End with without with - excel

i keep getting a compile message 'end with without with'
im new to this and i cant see a problem i have a 'With' followed by and 'End with'. if i remove the end with i get a if with out end if.
Private Sub Submitnewcustomer_Click()
Dim RowCount As Long
Dim ctl As Control
If Me.companynameinput.Value = "" Then
MsgBox "Please enter a Company Name.", vbExclamation, "Britannia Monitoring Systems"
Me.companynameinput.SetFocus
Exit Sub
End If
If Me.contactnameinput.Value = "" Then
MsgBox "Please enter a Contact Name.", vbExclamation, "Britannia Monitoring Systems"
Me.companynameinput.SetFocus
Exit Sub
End If
If Me.addressinput.Value = "" Then
MsgBox "Please enter an Address.", vbExclamation, "Britannia Monitoring Systems"
Me.companynameinput.SetFocus
Exit Sub
End If
If Me.Telphone1input.Value = "" Then
MsgBox "Please enter at least 1 phone Number.", vbExclamation, "Britannia Monitoring Systems"
Me.Telphone1input.SetFocus
Exit Sub
End If
If Me.email1input.Value = "" Then
MsgBox "Please enter at least 1 Email Address.", vbExclamation, "Britannia Monitoring Systems"
Me.email1input.SetFocus
End If
RowCount = Worksheets("Database").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Database").Range("A1")
.Offset(RowCount, 0).Value = Me.companynameinput.Value
.Offset(RowCount, 1).Value = Me.contactnameinput.Value
.Offset(RowCount, 2).Value = Me.Telphone1input.Value
.Offset(RowCount, 3).Value = Me.telephone2input.Value
.Offset(RowCount, 4).Value = Me.email1input.Value
.Offset(RowCount, 5).Value = Me.email2input.Value
.Offset(RowCount, 6).Value = Me.email3input.Value
.Offset(RowCount, 7).Value = Me.email4input.Value
.Offset(RowCount, 8).Value = Me.addressinput.Value
.Offset(RowCount, 15).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
If Me.CheckBox1.Value = True Then
.Offset(RowCount, 12).Value = "Yes"
Else
.Offset(RowCount, 12).Value = "No"
If Me.CheckBox2.Value = True Then
.Offset(RowCount, 13).Value = "Yes"
Else
.Offset(RowCount, 13).Value = "No"
If Me.CheckBox3.Value = True Then
.Offset(RowCount, 14).Value = "Yes"
Else
.Offset(RowCount, 14).Value = "No"
End If
End With
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
I have just struggled for 30 minutes just to post this on here
any help would be great thanks

You are missing a couple of End Ifs in this section. You'll need to sort that out before your code will compile correctly.
If Me.CheckBox1.Value = True Then
.Offset(RowCount, 12).Value = "Yes"
Else
.Offset(RowCount, 12).Value = "No"
If Me.CheckBox2.Value = True Then
.Offset(RowCount, 13).Value = "Yes"
Else
.Offset(RowCount, 13).Value = "No"
If Me.CheckBox3.Value = True Then
.Offset(RowCount, 14).Value = "Yes"
Else
.Offset(RowCount, 14).Value = "No"
End If

Related

Insert userform data into next column on respective rows

I want to add the values from a form to an Excel sheet.
I have the "headers" in column A from A1 down to A20 with A21 a "score" field that runs from B21 to CZ21 that automatically calculates a score based on the values entered above in each respective column.
A1 through 20 has the headers for the questions and I want the values from the form entered initially in B1 through 20 and then C1-20 and so on and so forth.
As an example, the first form response should be entered into rows B1 to B20 with each row having a value. The second form response will be entered into rows C1 to C20 with each row having it's own value.
Column A is a frozen pane.
Private Sub SaveButton_Click()
'Make Sheet2 active
Sheet4.Activate
'Determine empty Row
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(emptyRow, 2).Value = TextBox1.Value
Cells(emptyRow, 3).Value = Format(Now)
Cells(emptyRow, 4).Value = TextBox3.Value
If CheckBox1.Value = True Then
Cells(emptyRow, 5).Value = CheckBox1
Else
Cells(emptyRow, 5).Value = CheckBox1
End If
If CheckBox2.Value = True Then
Cells(emptyRow, 6).Value = CheckBox2
Else
Cells(emptyRow, 6).Value = CheckBox2
End If
If CheckBox3.Value = True Then
Cells(emptyRow, 7).Value = CheckBox3
Else
Cells(emptyRow, 7).Value = CheckBox3
End If
If CheckBox4.Value = True Then
Cells(emptyRow, 8).Value = CheckBox4
Else
Cells(emptyRow, 8).Value = CheckBox4
End If
If CheckBox9.Value = True Then
Cells(emptyRow, 9).Value = CheckBox9
Else
Cells(emptyRow, 9).Value = CheckBox9
End If
If CheckBox11.Value = True Then
Cells(emptyRow, 10).Value = CheckBox11
Else
Cells(emptyRow, 10).Value = CheckBox11
End If
If CheckBox14.Value = True Then
Cells(emptyRow, 11).Value = CheckBox14
Else
Cells(emptyRow, 11).Value = CheckBox14
End If
If CheckBox16.Value = True Then
Cells(emptyRow, 12).Value = CheckBox16
Else
Cells(emptyRow, 12).Value = CheckBox16
End If
If CheckBox18.Value = True Then
Cells(emptyRow, 13).Value = CheckBox18
Else
Cells(emptyRow, 13).Value = CheckBox18
End If
If CheckBox20.Value = True Then
Cells(emptyRow, 14).Value = CheckBox20
Else
Cells(emptyRow, 14).Value = CheckBox20
End If
If CheckBox22.Value = True Then
Cells(emptyRow, 15).Value = CheckBox22
Else
Cells(emptyRow, 15).Value = CheckBox22
End If
If CheckBox24.Value = True Then
Cells(emptyRow, 16).Value = CheckBox24
Else
Cells(emptyRow, 16).Value = CheckBox24
End If
If CheckBox26.Value = True Then
Cells(emptyRow, 17).Value = CheckBox26
Else
Cells(emptyRow, 17).Value = CheckBox26
End If
If CheckBox27.Value = True Then
Cells(emptyRow, 18).Value = CheckBox27
Else
Cells(emptyRow, 18).Value = CheckBox27
End If
If CheckBox28.Value = True Then
Cells(emptyRow, 19).Value = CheckBox28
Else
Cells(emptyRow, 19).Value = CheckBox28
End If
Cells(emptyRow, 20).Value = TextBox5.Value
Cells(emptyRow, 21).Value = TextBox4.Value
'Clearing data
CheckBox1.Value = "False"
CheckBox2.Value = "False"
CheckBox3.Value = "False"
CheckBox4.Value = "False"
CheckBox9.Value = "False"
CheckBox11.Value = "False"
CheckBox14.Value = "False"
CheckBox16.Value = "False"
CheckBox18.Value = "False"
CheckBox20.Value = "False"
CheckBox22.Value = "False"
CheckBox24.Value = "False"
CheckBox26.Value = "False"
CheckBox27.Value = "False"
CheckBox28.Value = "False"
TextBox1.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
End Sub
You can do something like this
Private Sub SaveButton_Click()
Dim col as Range
Set col = Sheet4.Range("B1:B20") 'first potential location
'find first unused column
Do While Application.CountA(col) > 0
Set col = col.Offset(0, 1)
Loop
col.cells(1).Value = TextBox1.Value
col.cells(2).Value = Format(Now)
col.cells(3).Value = TextBox3.Value
'etc etc

How to make a multi-select listbox selection required in a userform?

I have a userform with a multi-select list box.
The code I wrote expects the user to select two options.
I need that the user gets an error message only if they don't select at least one option.
I started with the code for a single-select list box error message. I tried making it >= -1 <0 <>-1 and none of them allow the user to select just one option.
The line in question is:
If ListBoxNextSteps.ListIndex <> 1 Then
MsgBox "Please select next steps"
Exit Sub
End If
Private Sub CommandButtonSubmit_Click()
'Requires specific fields to be complete before user can submit
If ComboBoxDBN = "" Then
MsgBox "Please select a DBN"
Exit Sub
End If
If TextBoxDate = "" Then
MsgBox "Plese enter a date"
Exit Sub
End If
If CheckBoxCohort = False Then
If TextBoxContactName = "" Then
MsgBox "Please list school officials that you contacted"
Exit Sub
End If
If ListBoxSupportType.ListIndex = -1 Then
MsgBox "Please select a support type"
Exit Sub
End If
If TextBoxDiscussion = "" Then
MsgBox "Please describe your discussion points"
Exit Sub
End If
If TextBoxLearn = "" Then
MsgBox "Please describe what you learned about the school's challenges"
Exit Sub
End If
If (CheckBoxAdminDiff + CheckBoxConflict + CheckBoxShortage + CheckBoxDataSystems + CheckBoxOther) = 0 Then
MsgBox "Please select at least one bucket"
Exit Sub
End If
If (CheckBoxOther = True And TextBoxIfOther = "") Then
MsgBox "Please describe other bucket"
Exit Sub
End If
If ListBoxNextSteps.ListIndex <> 1 Then
MsgBox "Please select next steps"
Exit Sub
End If
If ListBoxResolution.ListIndex = -1 Then
MsgBox "Please select a resolution status"
Exit Sub
End If
End If
'tells form to put responses in a long table
Dim emptyRow As Long
'Make Sheet1 (SchoolSupport) active so it knows where to put the responses
Sheet1.Activate
ActiveSheet.Protect UserInterfaceOnly:=True, AllowFiltering:=True
'Determine emptyRow so it knows where the next entry goes
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information from form fields to table cells
Cells(emptyRow, 1).Value = ComboBoxDBN.Value
Cells(emptyRow, 2).Value = TextBoxDate.Value
Cells(emptyRow, 3).Value = TextBoxContactName.Value
Cells(emptyRow, 6).Value = ListBoxSupportType.Value
Cells(emptyRow, 7).Value = TextBoxDiscussion.Value
Cells(emptyRow, 8).Value = TextBoxBestPractice.Value
Cells(emptyRow, 9).Value = TextBoxLearn.Value
Cells(emptyRow, 15).Value = TextBoxIfOther.Value
'Makes sure multiple selections appear in same cell
If CheckBoxCohort = False Then
Dim s As String, i As Integer
With ListBoxNextSteps
For i = 0 To .ListCount - 1
If .Selected(i) = True Then s = s & .List(i) & ", "
Next i
End With
With Cells(emptyRow, 16)
.Value = Left(s, Len(s) - 1)
End With
End If
Cells(emptyRow, 17).Value = ListBoxResolution.Value
Cells(emptyRow, 18).Value = TextBoxEscalateTo.Value
Cells(emptyRow, 19).Value = ListBoxEscalateLocation.Value
Cells(emptyRow, 20).Value = ListBoxEscalateStatus.Value
Cells(emptyRow, 21).Value = TextBoxPertinentNotes.Value
If CheckBoxUnresponsive.Value = True Then Cells(emptyRow, 4).Value = "Y"
If CheckBoxCohort.Value = True Then Cells(emptyRow, 5).Value = "Y"
If CheckBoxAdminDiff.Value = True Then Cells(emptyRow, 10).Value = "Y"
If CheckBoxConflict.Value = True Then Cells(emptyRow, 11).Value = "Y"
If CheckBoxShortage.Value = True Then Cells(emptyRow, 12).Value = "Y"
If CheckBoxDataSystems.Value = True Then Cells(emptyRow, 13).Value = "Y"
If CheckBoxOther.Value = True Then Cells(emptyRow, 14).Value = "Y"
'Saves workbook
Application.ActiveWorkbook.Save
Unload SchoolSupportForm
End Sub
I expect the ListBoxNextSteps error message to appear only if the user hasn't made any selection, but instead, it appears if the user hasn't made at least 2 selections.
You can use the Selected method of the ListBox object to check whether an item is selected. The following code loops through each item in the listbox. If an item is selected, the boolean variable itemSelected is set to True and the For/Next loop is exited. After exiting the loop, if itemSelected is set to False, the message is displayed and then it exits the sub.
Dim itemSelected As Boolean
Dim i As Long
itemSelected = False
With Me.ListBoxNextSteps
For i = 0 To .ListCount - 1
If .Selected(i) Then
itemSelected = True
Exit For
End If
Next i
End With
If Not itemSelected Then
MsgBox "Please select next steps"
Exit Sub
End If

Excel VBA - Runtime error 438 : Object doesn't support this property or method

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

Data validation in user form

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

Copy-paste cell values to other sheets

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″)

Resources