Excel Sharing sheet with vba and working buttons - excel

I'm trying to share a sheet with a button that open a new window(made in vb) but when I share it the button that guides to another window lock simple doesn't work (yes I unchecked lock), theres something I need to do to share that button and the another window?
The work of this windows is to edit cells.
Here's the code from the window, there's:
private Sub CommandButton1_Click()
Dim i, a, b, c, d
Dim prio As String
i = CInt(Sheets("Sheet1").Cells(6, 17))
a = CInt(Sheets("Sheet1").Cells(7, 17))
Sheets("Sheet1").Cells(i, 1) = a
Sheets("Sheet1").Cells(i, 2) = Peca.Text
Sheets("Sheet1").Cells(i, 3) = Qt.Text
Sheets("Sheet1").Cells(i, 4) = ComboBox1.Value
Sheets("Sheet1").Cells(i, 5) = Responsavel.Text
Sheets("Sheet1").Cells(i, 6) = Cliente.Text
Sheets("Sheet1").Cells(i, 7) = Maquina.Text
Sheets("Sheet1").Cells(i, 8) = NumSerie.Text
Sheets("Sheet1").Cells(i, 9) = Modelo.Text
Sheets("Sheet1").Cells(i, 10) = Obser.Text
Sheets("Sheet1").Cells(6, 17) = CInt(Sheets("Sheet1").Cells(6, 17)) + 1
Sheets("Sheet1").Cells(7, 17) = CInt(Sheets("Sheet1").Cells(7, 17)) + 1
Peca.Text = ""
Qt.Text = ""
ComboBox1.Value = ""
Responsavel.Text = ""
Cliente.Text = ""
Maquina.Text = ""
NumSerie.Text = ""
Modelo.Text = ""
Obser.Text = ""
End Sub
Private Sub CommandButton2_Click()
Sheets("Sheet1").Cells(12, 15) = Cliente.Text
End Sub
Private Sub CommandButton3_Click()
Sheets("Sheet1").Cells(12, 15) = Maquina.Text
Sheets("Sheet1").Cells(13, 15) = NumSerie.Text
Sheets("Sheet1").Cells(14, 15) = Modelo.Text
End Sub
Private Sub CommandButton4_Click()
Cliente.Text = Sheets("Sheet1").Cells(12, 15)
End Sub
Private Sub CommandButton5_Click()
Maquina.Text = Sheets("Sheet1").Cells(12, 15)
NumSerie.Text = Sheets("Sheet1").Cells(13, 15)
Modelo.Text = Sheets("Sheet1").Cells(14, 15)
End Sub

Related

Editing rows works for one listbox but not another

I have a form with two different listboxes. One for downtime data and one for production data. I can add new data and delete data via both listboxes. I can edit a selected row as well. The problem I'm running into is that after I edit and update a row for the production listbox and then enter in new data for new row it keeps putting that data in the last row I edited. If I don't edit a row then anytime I add new data it automatically goes to the next row. This doesn't happen with the downtime section, only the production section. With the downtime section everything works as it should. Attached is the workbook. Any help is greatly appreciated.
This is the code to update the listbox with what was entered into the text boxes above the listbox.
Sub Prod_Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("ADHData")
If MainForm.txtRowNumberProd.Value = "" Then
iRow = [Counta(ADHData!A:A)] + 1
Else
iRow = MainForm.txtRowNumberProd.Value
End If
With sh
.Cells(iRow, 1) = MainForm.OrderA.Value
.Cells(iRow, 2) = MainForm.StockA.Value
.Cells(iRow, 3) = MainForm.FaceA.Value
.Cells(iRow, 4) = MainForm.LinerA.Value
.Cells(iRow, 5) = MainForm.WidthA.Value
.Cells(iRow, 6) = MainForm.PrevContA.Value
.Cells(iRow, 7) = MainForm.ContA.Value
.Cells(iRow, 8) = MainForm.PrevGoodA.Value
.Cells(iRow, 9) = MainForm.GoodA.Value
End With
End Sub
This is my code for selecting the row that needs to be edited
Private Sub CommandButton2_Click()
If Select_Prod = 0 Then
MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
Exit Sub
End If
MainForm.txtRowNumberProd.Value = Select_Prod + 1
MainForm.OrderA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 0)
MainForm.StockA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 1)
MainForm.FaceA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 2)
MainForm.LinerA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 3)
MainForm.WidthA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 4)
MainForm.PrevContA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 5)
MainForm.ContA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 6)
MainForm.PrevGoodA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 7)
MainForm.GoodA.Value = MainForm.Production_TableA.List(MainForm.Production_TableA.ListIndex, 8)
MsgBox "Please make the required changes and update the new production data.", vbOKOnly + vbInformation, "Edit"
End Sub
And this is my Select_Prod Code
Function Select_Prod() As Long
Dim i As Long
Select_Prod = 0
For i = 0 To MainForm.Production_TableA.ListCount - 1
If MainForm.Production_TableA.Selected(i) = True Then
Select_Prod = i + 1
Exit For
End If
Next i
End Function
And my code to reset the textboxes
Sub Prod_Reset()
Dim iRow As Long
iRow = [Counta(ADHData!A:A)] + 1 ' idetifying the last row
With MainForm
MainForm.OrderA.Value = ""
MainForm.StockA.Value = ""
MainForm.FaceA.Value = ""
MainForm.LinerA.Value = ""
MainForm.WidthA.Value = ""
MainForm.PrevContA.Value = ""
MainForm.ContA.Value = ""
MainForm.PrevGoodA.Value = ""
MainForm.GoodA.Value = ""
.Production_TableA.ColumnCount = 9
.Production_TableA.ColumnHeads = True
.Production_TableA.ColumnWidths = "55,55,70,71,50,106,77,69,42"
If iRow > 1 Then
.Production_TableA.RowSource = "ADHData!A2:J" & iRow
Else
.Production_TableA.RowSource = "ADHData!A2:J21"
End If
End With
End Sub

Insert TextBox value into first empty cell in column

I have the following code which works fine. (TextBoxes are on "UserForm" in Excel VBA, and executes with clicking CommandButton1 on that UserForm.) But can anyone help me to insert the value of each TextBox into the first empty cell in Column M? This way inserts empty rows. I will use this in several workbooks, so using "ActiveSheet" is easiest for me.
Sub UserForm_Initialize()
Me.TextBox1.Value = CStr(ActiveSheet.Range("M1").Value)
Me.TextBox2.Value = CStr(ActiveSheet.Range("M2").Value)
Me.TextBox3.Value = CStr(ActiveSheet.Range("M3").Value)
Me.TextBox4.Value = CStr(ActiveSheet.Range("M4").Value)
Me.TextBox5.Value = CStr(ActiveSheet.Range("M5").Value)
Me.TextBox6.Value = CStr(ActiveSheet.Range("M6").Value)
Me.TextBox7.Value = CStr(ActiveSheet.Range("M7").Value)
Me.TextBox8.Value = CStr(ActiveSheet.Range("M8").Value)
Me.TextBox9.Value = CStr(ActiveSheet.Range("M9").Value)
Me.TextBox10.Value = CStr(ActiveSheet.Range("M10").Value)
Me.TextBox11.Value = CStr(ActiveSheet.Range("M11").Value)
Me.TextBox12.Value = CStr(ActiveSheet.Range("M12").Value)
Me.TextBox13.Value = CStr(ActiveSheet.Range("M13").Value)
Me.TextBox14.Value = CStr(ActiveSheet.Range("M14").Value)
Me.TextBox15.Value = CStr(ActiveSheet.Range("M15").Value)
Me.TextBox16.Value = CStr(ActiveSheet.Range("M16").Value)
Me.TextBox17.Value = CStr(ActiveSheet.Range("M17").Value)
Me.TextBox18.Value = CStr(ActiveSheet.Range("M18").Value)
Me.TextBox19.Value = CStr(ActiveSheet.Range("M19").Value)
Me.TextBox20.Value = CStr(ActiveSheet.Range("M20").Value)
Me.TextBox21.Value = CStr(ActiveSheet.Range("M21").Value)
Me.TextBox22.Value = CStr(ActiveSheet.Range("M22").Value)
End Sub
'Insert Button
Private Sub CommandButton1_Click()
Range("M1") = Me.TextBox1.Text
Range("M2") = Me.TextBox2.Text
Range("M3") = Me.TextBox3.Text
Range("M4") = Me.TextBox4.Text
Range("M5") = Me.TextBox5.Text
Range("M6") = Me.TextBox6.Text
Range("M7") = Me.TextBox7.Text
Range("M8") = Me.TextBox8.Text
Range("M9") = Me.TextBox9.Text
Range("M10") = Me.TextBox10.Text
Range("M11") = Me.TextBox11.Text
Range("M12") = Me.TextBox12.Text
Range("M13") = Me.TextBox13.Text
Range("M14") = Me.TextBox14.Text
Range("M15") = Me.TextBox15.Text
Range("M16") = Me.TextBox16.Text
Range("M17") = Me.TextBox17.Text
Range("M18") = Me.TextBox18.Text
Range("M19") = Me.TextBox19.Text
Range("M20") = Me.TextBox20.Text
Range("M21") = Me.TextBox21.Text
Range("M22") = Me.TextBox22.Text
Range("A25").Value = "Hide"
Unload Me
End Sub
Sub CommandButton2_Click()
'Cancel button
Unload Me
End Sub
EDIT: last guess
You can do something like this:
Private Sub CommandButton1_Click()
Dim i As Long, c As Range
ActiveSheet.Range("M1:M22").ClearContents
Set c = ActiveSheet.Range("M1")
For i = 1 to 22
c.Value = Me.Controls("TextBox" & i).Text
If Len(c.Value) > 0 then Set c = c.offset(1, 0)
Next i
Unload Me
End Sub

Saving a new entry in Excel VBA does not save the new entry

I have the following code to Save a new entry. I display the record selected from the list box. When the user press 'Add New', I clear the text boxes and allow them to enter new data in the text boxes. When they press 'Save', only the first text box (membership no) is saved with new value. All the columns take the value of the record which was displayed before the user press 'Add New' button.
Private Sub btnSave_Click()
Dim ws As Worksheet
Dim newrow As Long
Set ws = Worksheets("Master")
newrow = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1
ws.Cells(newrow, 1).Value = Me.txtMembershipNo.Value
ws.Cells(newrow, 2).Value = Me.txtName.Value
ws.Cells(newrow, 3).Value = Me.txtAddress.Value
ws.Cells(newrow, 4).Value = Me.cmboxState.Value
ws.Cells(newrow, 5).Value = Me.cmboxCategory.Value
ws.Cells(newrow, 6).Value = Me.cmboxType.Value
ws.Cells(newrow, 7).Value = Me.cmboxStatus.Value
ws.Cells(newrow, 8).Value = Me.txtRemarks.Value
btnDelete.Enabled = True
btnAddNew.Enabled = True
btnUpdate.Enabled = False
btnSave.Enabled = False
btnCancel.Enabled = False
End Sub
Private Sub ListBox1_Click()
txtMembershipNo.Text = ListBox1.List(ListBox1.ListIndex, 0)
txtName.Text = ListBox1.List(ListBox1.ListIndex, 1)
txtAddress.Text = ListBox1.List(ListBox1.ListIndex, 2)
cmboxState.Text = ListBox1.List(ListBox1.ListIndex, 3)
cmboxCategory.Text = ListBox1.List(ListBox1.ListIndex, 4)
cmboxType.Text = ListBox1.List(ListBox1.ListIndex, 5)
cmboxStatus.Text = ListBox1.List(ListBox1.ListIndex, 6)
txtRemarks.Text = ListBox1.List(ListBox1.ListIndex, 7)
btnDelete.Enabled = True
btnUpdate.Enabled = True
End Sub

VBA Run time Error '70': Could not Set the list property. Permission Denied

I am trying to update the data by clicking the Listbox,but getting error, please see my code below.
Using below code to display the list box value to text boxes
Private Sub ListBox1_Click()
Dim i As Integer
i = Me.ListBox1.ListIndex
Me.ListBox1.Selected(i) = True
Me.TextBox1.Value = Me.ListBox1.Column(0, i)
Me.TextBox2.Value = Me.ListBox1.Column(1, i)
Me.TextBox3.Value = Me.ListBox1.Column(2, i)
Me.TextBox4.Value = Me.ListBox1.Column(3, i)
End Sub
Trying to update data with following code and getting error.
Private Sub btnUpdate_Click()
If ListBox1.ListIndex <> -1 Then
With ListBox1
.List(.ListIndex, 0) = TextBox1.Value
.List(.ListIndex, 1) = TextBox2.Value
.List(.ListIndex, 2) = TextBox3.Value
.List(.ListIndex, 3) = TextBox4.Value
End With
End If
End Sub
enter code here
Any help will be greatly appreciated.
Unlike ComboBoxes, you can't edit values in a ListBox on the fly like this. You have to delete the entry and insert one back in, with your new values. I'm not sure this is the most elegant way to do it, but the following works:
Private Sub btnUpdate_Click()
Dim values(3)
Dim u As Long
u = ListBox1.ListIndex
If u <> -1 Then
values(0) = TextBox1.Value
values(1) = TextBox2.Value
values(2) = TextBox3.Value
values(3) = TextBox4.Value
With ListBox1
.RemoveItem u
.AddItem values(0), u
.List(u, 1) = values(1)
.List(u, 2) = values(2)
.List(u, 3) = values(3)
End With
End If
End Sub
Private Sub ListBox1_Click()
Dim i As Long
With Me
i = .ListBox1.ListIndex
.ListBox1.Selected(i) = True
.TextBox1.Value = .ListBox1.Column(0, i)
.TextBox2.Value = .ListBox1.Column(1, i)
.TextBox3.Value = .ListBox1.Column(2, i)
.TextBox4.Value = .ListBox1.Column(3, i)
End With
End Sub
As I say, not elegant: I had to store the values of TextBox1 etc. in the array as when the RemoveItem runs, the Index changes which causes the ListBox1_Click to run - resetting all the Textboxes.

Skip first 3 header rows

I have a form that is currently allowing input from my form in VBA into my Excel spreadsheet. When I use the Previous button or the next button it deletes everything from a prior input into what is on the form. is there a way to Click previous and see the previous data entered, allow editting but change to the fields when you select the previous button again?
Public nCurrentRow As Long
Private Sub Next_Command_Click()
Do
nCurrentRow = nCurrentRow + 1
TraverseData (nCurrentRow)
Loop Until C_C_L.Cells(nCurrentRow, 1).Value = "" Or C_C_L.Cells(nCurrentRow, 1).Value = Me.PI_Text.Value
End Sub
Private Sub Previous_Command_Click()
Do
nCurrentRow = nCurrentRow - 1
TraverseData (nCurrentRow)
Loop Until nCurrentRow = 1 Or C_C_L.Cells(nCurrentRow, 1).Value = Me.PI_Text.Value
End Sub
Also Is there a way to skip the first 3 lines (headers) so the new data does not overwrite my headers?
You should add another button AddRecord_Command that will bring the set the current row to the next empty row. In this way, Previous_Command will move back one record and Next_Command will not move past the last record.
The code below should handle both this question and your previous question How to update spreadsheet from VBA Form?
Option Explicit
Private NC_C_L As Worksheet
Private nCurrentRow As Long
Private firstRow As Long
Private Sub UserForm_Initialize()
Set NC_C_L = Worksheets("Sheet1")
firstRow = 4
ReadData
End Sub
Private Sub AddRecord_Command_Click()
Dim lastRow As Long
lastRow = NC_C_L.Range("A" & NC_C_L.Rows.Count).End(xlUp).Row
WriteData
nCurrentRow = lastRow + 1
End Sub
Private Sub Next_Command_Click()
Dim lastRow As Long
lastRow = NC_C_L.Range("A" & NC_C_L.Rows.Count).End(xlUp).Row
If nCurrentRow < lastRow Then
WriteData
nCurrentRow = nCurrentRow + 1
ReadData
End If
End Sub
Private Sub Previous_Command_Click()
If nCurrentRow > firstRow Then
WriteData
nCurrentRow = nCurrentRow - 1
ReadData
End If
End Sub
Private Sub ReadData()
With NC_C_L
Me.A_Text.Value = .Cells(nCurrentRow, 1)
Me.B_Box = .Cells(nCurrentRow, 2)
Me.C_Combo.Value = .Cells(nCurrentRow, 3)
Me.C_Combo.Value = .Cells(nCurrentRow, 4)
Me.F_Combo.Value = .Cells(nCurrentRow, 5)
Me.H_Combo.Value = .Cells(nCurrentRow, 6)
Me.I_Combo.Value = .Cells(nCurrentRow, 7)
Me.J_Text.Value = .Cells(nCurrentRow, 8)
Me.K_Text.Value = .Cells(nCurrentRow, 9)
Me.Comments1_Text.Value = .Cells(nCurrentRow, 10)
Me.Comments2_Text.Value = .Cells(nCurrentRow, 11)
Me.Comments3_Text.Value = .Cells(nCurrentRow, 12)
Me.PhoneNumber_Text.Value = .Cells(nCurrentRow, 13)
Me.Address1_Text.Value = .Cells(nCurrentRow, 14)
Me.Address2_Text.Value = .Cells(nCurrentRow, 15)
Me.City_Text.Value = .Cells(nCurrentRow, 16)
Me.State_Combo.Value = .Cells(nCurrentRow, 17)
Me.Zip_Text.Value = .Cells(nCurrentRow, 18)
Me.EMail_Text.Value = .Cells(nCurrentRow, 19)
Me.P_Name_Text.Value = .Cells(nCurrentRow, 20)
Me.P_PhoneNumber_Text.Value = .Cells(nCurrentRow, 21)
Me.P_Address_Text.Value = .Cells(nCurrentRow, 22)
End With
End Sub
Private Sub WriteData()
With NC_C_L
.Cells(nCurrentRow, 1) = Me.A_Text.Value
.Cells(nCurrentRow, 2) = Me.B_Box
.Cells(nCurrentRow, 3) = Me.C_Combo.Value
.Cells(nCurrentRow, 4) = Me.C_Combo.Value
.Cells(nCurrentRow, 5) = Me.F_Combo.Value
.Cells(nCurrentRow, 6) = Me.H_Combo.Value
.Cells(nCurrentRow, 7) = Me.I_Combo.Value
.Cells(nCurrentRow, 8) = Me.J_Text.Value
.Cells(nCurrentRow, 9) = Me.K_Text.Value
.Cells(nCurrentRow, 10) = Me.Comments1_Text.Value
.Cells(nCurrentRow, 11) = Me.Comments2_Text.Value
.Cells(nCurrentRow, 12) = Me.Comments3_Text.Value
.Cells(nCurrentRow, 13) = Me.PhoneNumber_Text.Value
.Cells(nCurrentRow, 14) = Me.Address1_Text.Value
.Cells(nCurrentRow, 15) = Me.Address2_Text.Value
.Cells(nCurrentRow, 16) = Me.City_Text.Value
.Cells(nCurrentRow, 17) = Me.State_Combo.Value
.Cells(nCurrentRow, 18) = Me.Zip_Text.Value
.Cells(nCurrentRow, 19) = Me.EMail_Text.Value
.Cells(nCurrentRow, 20) = Me.P_Name_Text.Value
.Cells(nCurrentRow, 21) = Me.P_PhoneNumber_Text.Value
.Cells(nCurrentRow, 22) = Me.P_Address_Text.Value
End With
End Sub

Resources