nicic
09-19-2023, 08:34 AM
Hi all,
Hoping you can help. Been a long time (a few decades) since I've played with excel properly. I need some spreadsheets doing, so thought I'd throw myself back in. I've been trying to make a user form using a tutorial and changing for my own needs. It works well (needs prettying up), but when I save data from form to the table, sometimes it works and sometimes it throws an error. It's driving me mad. Can anyone have a look for me?
Thanks so much..
31053
Code:
First form:
Private Sub buttonclose_Click()
Unload Me
End Sub
Private Sub buttonDelete1_Click()
Dim answer As Integer
answer = MsgBox("Are you sure you wnat to delete this entry?", vbQuestion + vbYesNo + vbDefaultButton2, "Delete")
If answer = vbYes Then Call buttonDelete2
End Sub
Private Sub buttonDelete2()
Call DeleteSelectedRow(AllergenDB.ListIndex)
End Sub
Private Sub buttonNew_Click()
Dim frm As New Enternewdata
frm.Show vbModal
' Refill the ListBox with data so the new staff member is included
Call AddDataToListbox1
End Sub
Private Sub UserForm_Initialize()
' Fill the listbox
Call AddDataToListbox1
End Sub
MAIN SUBS
' Add the data to the ListBox using RowSource
Private Sub AddDataToListbox1()
' Get the data range
Dim rg As Range
Set rg = GetRange1
' Link the data to the ListBox
With AllergenDB
.RowSource = rg.Address(External:=True)
.ColumnCount = rg.Columns.Count
.ColumnWidths = "80"
.ColumnHeads = True
.ListIndex = 0
End With
End Sub
New Data Form:
Private Sub CommandCloseNew_Click()
Unload Me
End Sub
' Save the record and clear the data from the controls
Private Function WriteDataToSheet1()
Dim newRow As Long
With Allergen_Database
' Get the first blank row of data
newRow = .Cells(.Rows.Count, 1).End(xlUp).row + 1
' Write the data
.Cells(newRow, 1).Value = TextBox1Name.Value
.Cells(newRow, 2).Value = Textbox2.Value
.Cells(newRow, 3).Value = Textbox3.Value
.Cells(newRow, 4).Value = TextBox4.Value
.Cells(newRow, 5).Value = TextBox5.Value
.Cells(newRow, 6).Value = TextBox6.Value
.Cells(newRow, 7).Value = TextBox7.Value
.Cells(newRow, 8).Value = TextBox8.Value
.Cells(newRow, 9).Value = TextBox9.Value
.Cells(newRow, 10).Value = TextBox10.Value
.Cells(newRow, 11).Value = TextBox11.Value
.Cells(newRow, 12).Value = TextBox12.Value
.Cells(newRow, 13).Value = TextBox13.Value
.Cells(newRow, 14).Value = TextBox14.Value
.Cells(newRow, 15).Value = TextBox15.Value
.Cells(newRow, 16).Value = TextBox16.Value
.Cells(newRow, 17).Value = TextBox17.Value
.Cells(newRow, 18).Value = TextBox18.Value
.Cells(newRow, 19).Value = TextBox19.Value
.Cells(newRow, 20).Value = TextBox20.Value
.Cells(newRow, 21).Value = TextBox21.Value
.Cells(newRow, 22).Value = TextBox22.Value
.Cells(newRow, 23).Value = TextBox23.Value
.Cells(newRow, 24).Value = TextBox24.Value
.Cells(newRow, 25).Value = TextBox25.Value
.Cells(newRow, 26).Value = TextBox26.Value
.Cells(newRow, 27).Value = TextBox27.Value
End With
End Function
' Clear data from the textbox controls
Public Sub EmptyTextboxes()
Dim c As Control
' Read through all the controls
For Each c In Me.Controls
If TypeName(c) = "TextBox" Then
c.Value = ""
End If
Next
End Sub
Private Sub CommandSaveNew_Click()
If MsgBox("Do you want to save this record?:", vbYesNo, "Save record") = vbYes Then
Call WriteDataToSheet1
' Remove data from textboxes
Call EmptyTextboxes
End If
End Sub
Module:
Public Function GetRange1() As Range
' Get the data range from the Staff worksheet
Set GetRange1 = Allergen_Database.Range("A2").CurrentRegion
' remove the header from the range by moving the range down one row and
' then removing the last row.
Set GetRange1 = GetRange1.Offset(1).Resize(GetRange1.Rows.Count - 1)
End Function
' Delete the row from the staff worksheet
Public Sub DeleteSelectedRow(ByVal row As Long)
' Offset moves the range a given number of rows
Allergen_Database.Range("A2").Offset(row).EntireRow.Delete
End Sub
Hoping you can help. Been a long time (a few decades) since I've played with excel properly. I need some spreadsheets doing, so thought I'd throw myself back in. I've been trying to make a user form using a tutorial and changing for my own needs. It works well (needs prettying up), but when I save data from form to the table, sometimes it works and sometimes it throws an error. It's driving me mad. Can anyone have a look for me?
Thanks so much..
31053
Code:
First form:
Private Sub buttonclose_Click()
Unload Me
End Sub
Private Sub buttonDelete1_Click()
Dim answer As Integer
answer = MsgBox("Are you sure you wnat to delete this entry?", vbQuestion + vbYesNo + vbDefaultButton2, "Delete")
If answer = vbYes Then Call buttonDelete2
End Sub
Private Sub buttonDelete2()
Call DeleteSelectedRow(AllergenDB.ListIndex)
End Sub
Private Sub buttonNew_Click()
Dim frm As New Enternewdata
frm.Show vbModal
' Refill the ListBox with data so the new staff member is included
Call AddDataToListbox1
End Sub
Private Sub UserForm_Initialize()
' Fill the listbox
Call AddDataToListbox1
End Sub
MAIN SUBS
' Add the data to the ListBox using RowSource
Private Sub AddDataToListbox1()
' Get the data range
Dim rg As Range
Set rg = GetRange1
' Link the data to the ListBox
With AllergenDB
.RowSource = rg.Address(External:=True)
.ColumnCount = rg.Columns.Count
.ColumnWidths = "80"
.ColumnHeads = True
.ListIndex = 0
End With
End Sub
New Data Form:
Private Sub CommandCloseNew_Click()
Unload Me
End Sub
' Save the record and clear the data from the controls
Private Function WriteDataToSheet1()
Dim newRow As Long
With Allergen_Database
' Get the first blank row of data
newRow = .Cells(.Rows.Count, 1).End(xlUp).row + 1
' Write the data
.Cells(newRow, 1).Value = TextBox1Name.Value
.Cells(newRow, 2).Value = Textbox2.Value
.Cells(newRow, 3).Value = Textbox3.Value
.Cells(newRow, 4).Value = TextBox4.Value
.Cells(newRow, 5).Value = TextBox5.Value
.Cells(newRow, 6).Value = TextBox6.Value
.Cells(newRow, 7).Value = TextBox7.Value
.Cells(newRow, 8).Value = TextBox8.Value
.Cells(newRow, 9).Value = TextBox9.Value
.Cells(newRow, 10).Value = TextBox10.Value
.Cells(newRow, 11).Value = TextBox11.Value
.Cells(newRow, 12).Value = TextBox12.Value
.Cells(newRow, 13).Value = TextBox13.Value
.Cells(newRow, 14).Value = TextBox14.Value
.Cells(newRow, 15).Value = TextBox15.Value
.Cells(newRow, 16).Value = TextBox16.Value
.Cells(newRow, 17).Value = TextBox17.Value
.Cells(newRow, 18).Value = TextBox18.Value
.Cells(newRow, 19).Value = TextBox19.Value
.Cells(newRow, 20).Value = TextBox20.Value
.Cells(newRow, 21).Value = TextBox21.Value
.Cells(newRow, 22).Value = TextBox22.Value
.Cells(newRow, 23).Value = TextBox23.Value
.Cells(newRow, 24).Value = TextBox24.Value
.Cells(newRow, 25).Value = TextBox25.Value
.Cells(newRow, 26).Value = TextBox26.Value
.Cells(newRow, 27).Value = TextBox27.Value
End With
End Function
' Clear data from the textbox controls
Public Sub EmptyTextboxes()
Dim c As Control
' Read through all the controls
For Each c In Me.Controls
If TypeName(c) = "TextBox" Then
c.Value = ""
End If
Next
End Sub
Private Sub CommandSaveNew_Click()
If MsgBox("Do you want to save this record?:", vbYesNo, "Save record") = vbYes Then
Call WriteDataToSheet1
' Remove data from textboxes
Call EmptyTextboxes
End If
End Sub
Module:
Public Function GetRange1() As Range
' Get the data range from the Staff worksheet
Set GetRange1 = Allergen_Database.Range("A2").CurrentRegion
' remove the header from the range by moving the range down one row and
' then removing the last row.
Set GetRange1 = GetRange1.Offset(1).Resize(GetRange1.Rows.Count - 1)
End Function
' Delete the row from the staff worksheet
Public Sub DeleteSelectedRow(ByVal row As Long)
' Offset moves the range a given number of rows
Allergen_Database.Range("A2").Offset(row).EntireRow.Delete
End Sub