![]() |
#2
|
||||
|
||||
![]()
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 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Hiding Command Buttons before PDF | ksigcajun | Word VBA | 3 | 05-07-2014 05:31 AM |
![]() |
chcope | PowerPoint | 2 | 06-13-2013 04:30 PM |
Command Buttons | lorenambrose | Word | 0 | 10-06-2011 11:55 AM |
command buttons | ronf | Excel | 0 | 04-28-2006 08:32 AM |
command buttons | ronf | Excel | 0 | 12-03-2005 06:26 AM |