Hi everyone, below are the nearly completed vba codes for the add, next, previous, search, delete and close buttons of a user Form. These codes were running okay but when I tried to add a new record and hit the "add" button, the following message from Smadav popped out:
"Macro in this excel file tried to execute unknown application. The action is blocked for security reason". Then excel restarts.
My knowledge of VBA is next to nothing so what I did was to search, copy, paste and edit the codes that I think would fit with the command buttons. The add command codes were running smoothly but when I added the codes for the search command, the message appeared.
Please help me point out the unknown application and would somebody else write the codes for the "insert" button. Thank you.
I'm not sure if I need to start a new thread for this.
Code:
Public nCurrentRow As Long
Private Sub cmdClear_Click()
ClearData
End Sub
Private Sub cmdInsert_Click()
End Sub
Private Sub UserForm_Initialize()
nCurrentRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
'TraverseData (nCurrentRow)
End Sub
Private Sub TraverseData(nRow As Long)
Me.cmbSchool.Value = Sheet2.Cells(nRow, 1)
Me.cmbSchoolID.Value = Sheet2.Cells(nRow, 2)
Me.tbxLRN.Value = Sheet2.Cells(nRow, 3)
Me.tbxLastName.Value = Sheet2.Cells(nRow, 4)
End Sub
Private Sub ClearData()
'Clear input controls.
Me.cmbSchool.Value = ""
Me.cmbSchoolID.Value = ""
Me.tbxLRN.Value = ""
Me.tbxLastName.Value = ""
End Sub
Private Sub cmdNext_Click()
Do
nCurrentRow = nCurrentRow + 1
TraverseData (nCurrentRow)
Loop Until Sheet2.Cells(nCurrentRow, 1).Value = "" Or Sheet2.Cells(nCurrentRow, 1).Value = Me.cmbSchool.Value
End Sub
Private Sub cmdPrevious_Click()
Do
nCurrentRow = nCurrentRow - 1
TraverseData (nCurrentRow)
Loop Until nCurrentRow = 1 Or Sheet2.Cells(nCurrentRow, 1).Value = Me.cmbSchool.Value
End Sub
Private Sub cmbSexGuard_DropButtonClick()
'Populate control.
Me.cmbSexGuard.AddItem "M"
Me.cmbSexGuard.AddItem "F"
End Sub
Private Sub cmbStatus_DropButtonClick()
'Populate control.
Me.cmbStatus.AddItem "Single"
Me.cmbStatus.AddItem "Married"
End Sub
Private Sub cmbRemarks_DropButtonClick()
'Populate control.
Me.cmbRemarks.AddItem "LE"
Me.cmbRemarks.AddItem "T/I"
End Sub
Private Sub cmbGrade_DropButtonClick()
'Populate control.
Me.cmbGrade.AddItem "KINDERGARTEN"
Me.cmbGrade.AddItem "ONE"
Me.cmbGrade.AddItem "TWO"
End Sub
Private Sub cmbAcadTrack_DropButtonClick()
'Populate control.
Me.cmbAcadTrack.AddItem "ABM"
Me.cmbAcadTrack.AddItem "HUMSS"
End Sub
Private Sub cmbSex_DropButtonClick()
'Populate control.
Me.cmbSex.AddItem "M"
Me.cmbSex.AddItem "F"
End Sub
Private Sub cmdAdd_Click()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
'Copy input values to sheet.
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
ApplicationScreenUpdating = False
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(lRow, 1).Value = Me.cmbSchool.Value
.Cells(lRow, 2).Value = Me.cmbSchoolID.Value
.Cells(lRow, 3).Value = Me.tbxLRN.Value
.Cells(lRow, 4).Value = Me.tbxLastName.Value
End With
'Clear input controls.
Me.cmbSchool.Value = ""
Me.cmbSchoolID.Value = ""
Me.tbxLRN.Value = ""
Me.tbxLastName.Value = ""
nCurrentRow = lRow
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the Close Form button!"
End If
End Sub
Private Sub cmdSearch_Click()
'Populate Control.
cmbSchool.Value = ""
cmbSchoolID.Value = ""
tbxLRN.Value = ""
tbxLastName.Value = ""
totRows = Worksheets("DATA").Range("A3").CurrentRegion.Rows.Count
For i = 2 To totRows
If Trim(Worksheets("DATA").Cells(i, 4)) = Trim(cmbLastName.Value) Then
cmbSchool.Value = Worksheets("DATA").Cells(i, 1).Value
cmbSchoolID.Value = Worksheets("DATA").Cells(i, 2).Value
tbxLRN.Value = Worksheets("DATA").Cells(i, 3).Value
tbxLastName.Value = Worksheets("DATA").Cells(i, 4).Value
End If
Next i
If cmbLastName.Value = "" Then
MsgBox "Select Last"
Else
cmdDelete.Enabled = True
End If
End Sub
Private Sub CmdDelete_Click()
Dim smessage As String
smessage = "Are you sure you want to delete? " & vbCrLf + vbCrLf + Chr(32) + cmbSchool.Text + Chr(32) + cmbSchoolID.Text + Chr(32) + tbxLRN.Text
If MsgBox(smessage, vbQuestion + vbYesNo, _
"Confirm Delete") = vbYes Then
Dim LastRow As Long, i As Long
'find last row of data in column A
LastRow = Columns(1).Find("*", SearchDirection:=xlPrevious).Row
'loop from last row to row 1
'For i = LastRow To 1 Step -1
' If Cells(i, "A") = cmbSchool.Text And Cells(i, "B") = cmbSchoolID.Text And Cells(i, "C") = tbxLRN.Text Then
Rows(nCurrentRow).Delete
ClearData
' End If
'Next
End If
'If Me.LastName = "" Then
' MsgBox "You have not selected a Last Name.", vbInformation
' Me.LastName.SetFocus
' Exit Sub
'End If
'FindRecord (Val(Me.LastName))
' If Not rngFound Is Nothing Then
' PopulateForm
' response = MsgBox("Are you sure you want to delete this record? " & Me.LastName & " on " & DATA & "!", vbYesNo + vbCritical)
' If response = vbYes Then rngFound.EntireRow.Delete
'Else
' MsgBox "There is no record with Last Name " & Me.LastName & " on " & DATA & "!", vbInformation
' Me.LastName.SetFocus
'End If
'ClearForm
End Sub