View Single Post
 
Old 12-04-2018, 05:07 AM
Marcia's Avatar
Marcia Marcia is offline Windows 7 32bit Office 2007
Expert
 
Join Date: May 2018
Location: Philippines
Posts: 551
Marcia has a spectacular aura aboutMarcia has a spectacular aura aboutMarcia has a spectacular aura about
Default

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

Last edited by Marcia; 12-05-2018 at 03:19 AM. Reason: Change tags from quote to code tags as per instruction by the moderator
Reply With Quote