Hi there
I am new at VBA and tried to create a user-form data imports data from a sheet called "Menu Planning Choices".
The Idea is that I can call up data and add, edit and change data. But the data does not pull thru as I expected it would.
Please I ask for assistance.
I am new at VBA and tried to create a user-form data imports data from a sheet called "Menu Planning Choices".
The Idea is that I can call up data and add, edit and change data. But the data does not pull thru as I expected it would.
Please I ask for assistance.
VBA Code:
Option Explicit
'Private variables
Dim cNum As Integer
Dim X As Integer
Private Sub cmdAdd_Click()
Dim nextrow As Range
'error handler
On Error GoTo errHandler:
'set the next row in the database
Set nextrow = Sheet1.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0)
'check for values in the first 4 controls
For X = 1 To 4
If Me.Controls("Reg" & X).Value = "" Then
MsgBox "You must add all data"
Exit Sub
End If
Next
'check for duplicate ID numbers
If WorksheetFunction.CountIf(Sheet1.Range("c:c"), Me.reg1.Value) > 0 Then
MsgBox "This ingedient already exists"
Exit Sub
End If
'number of controls to loop through
cNum = 36
'add the data to the database
For X = 1 To cNum
nextrow = Me.Controls("Reg" & X).Value
Set nextrow = nextrow.Offset(0, 1)
Next
'clear the controls
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'sort the database
Sortit
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdData_Click()
Sheet1.Select
End Sub
Sub Lookup()
'declare the variables
Dim rngFind As Range
Dim strFirstFind As String
'error statement
On Error GoTo errHandler:
'clear the listbox
lstLookup.Clear
'look up parts or all of full name
With Sheet1.Range("d:d")
Set rngFind = .Find(txtLookup.Text, LookIn:=xlValues, lookat:=xlPart)
'if value found then set a variable for the address
If Not rngFind Is Nothing Then
strFirstFind = rngFind.Address
'add the values to the listbox
Do
If rngFind.Row > 1 Then
lstLookup.AddItem rngFind.Value
lstLookup.List(lstLookup.ListCount - 1, 1) = rngFind.Offset(0, 1)
lstLookup.List(lstLookup.ListCount - 1, 3) = rngFind.Offset(0, 3)
lstLookup.List(lstLookup.ListCount - 1, 4) = rngFind.Offset(0, 4)
lstLookup.List(lstLookup.ListCount - 1, 5) = rngFind.Offset(0, 5)
lstLookup.List(lstLookup.ListCount - 1, 6) = rngFind.Offset(0, 6)
End If
'find the next address to add
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
End If
End With
'disable ID editing
Me.reg1.Enabled = False
Me.cmdEdit.Enabled = False
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdReset_Click()
'clear the Reg controls
cNum = 36
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'enable adding new Ingredient
Me.cmdAdd.Enabled = True
'enable adding new ID number
Me.reg1.Enabled = True
'clear the listbox
lstLookup.Clear
'clear the textbox
Me.txtLookup.Value = ""
End Sub
Private Sub cmdLookup_Click()
Lookup
End Sub
Private Sub Label91_Click()
End Sub
Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
Dim ID As String
Dim I As Integer
Dim findvalue
'error block
On Error GoTo errHandler:
'get the select value from the listbox
For I = 0 To lstLookup.ListCount - 1
If lstLookup.Selected(I) = True Then
ID = lstLookup.List(I, 1)
End If
Next I
'find the ID number
Set findvalue = Sheet1.Range("c:c").Find(What:=ID, LookIn:=xlValues).Offset(0, -3)
'add the database values to the userform
cNum = 36
For X = 1 To cNum
Me.Controls("Reg" & X).Value = findvalue
Set findvalue = findvalue.Offset(0, 1)
Next
'disable adding
Me.cmdAdd.Enabled = False
Me.cmdEdit.Enabled = True
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdDelete_Click()
'declare the variables
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
'check for values
If reg1.Value = "" Or Reg2.Value = "" Then
MsgBox "There is not data to delete"
Exit Sub
End If
'give the user a chance to change their mind
cDelete = MsgBox("Are you sure that you want to delete this Ingredient", vbYesNo + vbDefaultButton2, "Are you sure????")
If cDelete = vbYes Then
'delete the row
Set findvalue = Sheet1.Range("c:c").Find(What:=reg4, LookIn:=xlValues)
findvalue.EntireRow.Delete
End If
'clear the controls
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'refresh the listbox
Lookup
End Sub
Private Sub cmdEdit_Click()
'declare the variables
Dim findvalue As Range
'error handling
On Error GoTo errHandler:
'check for values
If Reg2.Value = "" Or Reg3.Value = "" Then
MsgBox "There is not data to edit"
Exit Sub
End If
'edit the row
Set findvalue = Sheet1.Range("c:c").Find(What:=reg1, LookIn:=xlValues).Offset(0, -3)
'if the edit is a name then add it
Me.reg4.Value = Me.Reg1Value + " " + Me.Reg2.Value
For X = 1 To cNum
findvalue = Me.Controls("Reg" & X).Value
Set findvalue = findvalue.Offset(0, 1)
Next
'refresh the listbox
Lookup
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & _
"The error number is: " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & "Please notify the administrator"
End Sub
Private Sub Reg2_Change()
'get the full name
Me.reg4.Value = Me.reg1.Value + " " + Me.Reg2.Value
End Sub
Private Sub UserForm_Click()
End SubAttachments
Last edited by a moderator:
