Run-time error 70 after code changed

WERNER SLABBERT

Board Regular
Joined
Mar 3, 2009
Messages
107
Hi since i updated my code the error 70 "Permission Denied" keeps me from activating my search form.
VBA Code:
Const SEARCH_BLANK As String = "[BLANK]"

Sub FilterData()
    Dim ws As Worksheet
    Dim i As Long
    Dim lastRow As Long
    Dim matchCriteria As Boolean
    
    ' Change "Sheet1" to the name of your worksheet with the data
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Clear previous results in the ListBox
    Me.lstResults.Clear
    
    ' Find the last row with data in the worksheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
    
    ' Loop through each row to check if it meets the criteria
    For i = 2 To lastRow  ' Assuming row 1 has headers
        matchCriteria = True
        
        ' Apply filters based on ComboBox values
        If Me.cboJobNr.Value <> "" And ws.Cells(i, 1).Value <> Me.cboJobNr.Value Then
            matchCriteria = False
        End If
        If Me.cboClient.Value <> "" And ws.Cells(i, 2).Value <> Me.cboClient.Value Then
            matchCriteria = False
        End If
        If Me.cboModel.Value <> "" And ws.Cells(i, 3).Value <> Me.cboModel.Value Then
            matchCriteria = False
        End If
        If Me.cboSerial.Value <> "" And ws.Cells(i, 4).Value <> Me.cboSerial.Value Then
            matchCriteria = False
        End If
        If Me.cboQuote.Value <> "" And ws.Cells(i, 7).Value <> Me.cboQuote.Value Then
            matchCriteria = False
        End If
        If Me.cboConfirmed.Value <> "" And ws.Cells(i, 8).Value <> Me.cboConfirmed.Value Then
            matchCriteria = False
        End If
        If Me.cboMailed.Value <> "" And ws.Cells(i, 9).Value <> Me.cboMailed.Value Then
            matchCriteria = False
        End If
        If Me.cboStatus.Value <> "" And ws.Cells(i, 10).Value <> Me.cboStatus.Value Then
            matchCriteria = False
        End If
        If Me.cboComplete.Value <> "" And ws.Cells(i, 11).Value <> Me.cboComplete.Value Then
            matchCriteria = False
        End If
        If Me.cboCollection.Value <> "" And ws.Cells(i, 12).Value <> Me.cboCollection.Value Then
            matchCriteria = False
        End If

        ' If the row matches all criteria, add it to the ListBox
        If matchCriteria Then
            With Me.lstResults
                .AddItem
                .List(.ListCount - 1, 0) = ws.Cells(i, 1).Value ' Job Nr
                .List(.ListCount - 1, 1) = ws.Cells(i, 2).Value ' Client
                .List(.ListCount - 1, 2) = ws.Cells(i, 3).Value ' Model
                .List(.ListCount - 1, 3) = ws.Cells(i, 4).Value ' Serial
                .List(.ListCount - 1, 4) = ws.Cells(i, 5).Value ' Received
                .List(.ListCount - 1, 5) = ws.Cells(i, 6).Value ' Assessed
                .List(.ListCount - 1, 6) = ws.Cells(i, 7).Value ' Quote
                .List(.ListCount - 1, 7) = ws.Cells(i, 8).Value ' Mailed
                .List(.ListCount - 1, 8) = ws.Cells(i, 9).Value ' Confirmed
                .List(.ListCount - 1, 9) = ws.Cells(i, 10).Value ' Complete
                .List(.ListCount - 1, 10) = ws.Cells(i, 11).Value ' Status
                .List(.ListCount - 1, 11) = ws.Cells(i, 12).Value ' Collection
            End With
        End If
    Next i
End Sub
Private Sub cmdSearch_Click()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Current Jobs") ' Make sure sheet name matches
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
    
    Dim row As Long
    Dim matchFound As Boolean
    Dim criteriaJobNr As String
    Dim criteriaClient As String
    Dim criteriaModel As String
    Dim criteriaStatus As String
    
    ' Retrieve user inputs
    criteriaJobNr = Me.cboJobNr.Value
    criteriaClient = Me.cboClient.Value
    criteriaModel = Me.cboModel.Value
    criteriaStatus = Me.cboStatus.Value

    ' Clear previous ListBox results
    Me.lstResults.Clear
    
    ' Loop through data rows and match criteria
    For row = 2 To lastRow
        matchFound = True
        
        ' Check each criterion; if empty, skip that criterion
        If criteriaJobNr <> "" And criteriaJobNr <> SEARCH_BLANK Then
            If ws.Cells(row, 1).Value <> criteriaJobNr Then matchFound = False
        ElseIf criteriaJobNr = SEARCH_BLANK Then
            If ws.Cells(row, 1).Value <> "" Then matchFound = False
        End If

        If criteriaClient <> "" And criteriaClient <> SEARCH_BLANK Then
            If ws.Cells(row, 2).Value <> criteriaClient Then matchFound = False
        ElseIf criteriaClient = SEARCH_BLANK Then
            If ws.Cells(row, 2).Value <> "" Then matchFound = False
        End If

        If criteriaModel <> "" And criteriaModel <> SEARCH_BLANK Then
            If ws.Cells(row, 3).Value <> criteriaModel Then matchFound = False
        ElseIf criteriaModel = SEARCH_BLANK Then
            If ws.Cells(row, 3).Value <> "" Then matchFound = False
        End If

        If criteriaStatus <> "" And criteriaStatus <> SEARCH_BLANK Then
            If ws.Cells(row, 11).Value <> criteriaStatus Then matchFound = False
        ElseIf criteriaStatus = SEARCH_BLANK Then
            If ws.Cells(row, 11).Value <> "" Then matchFound = False
        End If
        
        ' Add matching rows to ListBox if match found
        If matchFound Then
            Me.lstResults.AddItem ws.Cells(row, 1).Value & " | " & _
                                  ws.Cells(row, 2).Value & " | " & _
                                  ws.Cells(row, 3).Value & " | " & _
                                  ws.Cells(row, 11).Value
        End If
    Next row
End Sub

Private Sub UserForm_Initialize()
    ' Populate combo boxes using the named ranges
    ' Add SEARCH_BLANK as a constant option for searching blank values

    ' Job Number
    Me.cboJobNr.RowSource = "JobNr"
    Me.cboJobNr.AddItem SEARCH_BLANK
    
    ' Client Name
    Me.cboClient.RowSource = "Client"
    Me.cboClient.AddItem SEARCH_BLANK
    
    ' Model
    Me.cboModel.RowSource = "Model"
    Me.cboModel.AddItem SEARCH_BLANK
    
    ' Serial Number
    Me.cboSerial.RowSource = "Serial"
    Me.cboSerial.AddItem SEARCH_BLANK
    
    ' Quote Number
    Me.cboQuote.RowSource = "Quote"
    Me.cboQuote.AddItem SEARCH_BLANK
    
    ' Mailed Date
    Me.cboMailed.RowSource = "Mailed"
    Me.cboMailed.AddItem SEARCH_BLANK
    
    ' Confirmed
    Me.cboConfirmed.RowSource = "Confirmation"
    Me.cboConfirmed.AddItem SEARCH_BLANK
    
    ' Status Repair
    Me.cboStatusRepair.RowSource = "Status"
    Me.cboStatusRepair.AddItem SEARCH_BLANK
    
    ' Status Completed
    Me.cboStatusCompleted.RowSource = "Complete"
    Me.cboStatusCompleted.AddItem SEARCH_BLANK
    
    ' Status Collection
    Me.cboStatusCollection.RowSource = "Collection"
    Me.cboStatusCollection.AddItem SEARCH_BLANK
End Sub

Private Sub PopulateComboBox(cbo As ComboBox, ws As Worksheet, colLetter As String)
    Dim cell As Range
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Loop through the specified column, skipping the header
    For Each cell In ws.Range(colLetter & "2:" & colLetter & ws.Cells(ws.Rows.Count, colLetter).End(xlUp).row)
        If cell.Value <> "" Then
            dict(cell.Value) = True ' Add unique values to the dictionary
        End If
    Next cell

    ' Add dictionary keys to the ComboBox
    cbo.Clear
    Dim key As Variant
    For Each key In dict.Keys
        cbo.AddItem key
    Next key
End Sub

Private Sub cmdPrint_Click()
    If Me.lstResults.ListCount = 0 Then
        MsgBox "No results to print. Please search first.", vbExclamation
        Exit Sub
    End If
    
    ' Print each selected row from ListBox to the default printer
    Dim i As Integer
    For i = 0 To Me.lstResults.ListCount - 1
        Debug.Print Me.lstResults.List(i, 0) & " " & Me.lstResults.List(i, 1) ' Customize for print formatting
    Next i
    
    MsgBox "Printing complete.", vbInformation
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
You can't use AddItem with a combobox bound to a range using RowSource.
 
Upvote 1
You can't use AddItem with a combobox bound to a range using RowSource.
Hi Rory
Thank you for the reply, i must confess, i had help from an AI, i know some of the basics but just enough to get stuck, what would you suggest i change and how?
 
Upvote 0
None of the code in your Userform_Initialize event is going to work. (this is why we don't allow AI answers here) You either need to not add the blank (I'm not sure what the point of that is), or don't bind the controls directly to ranges, but populate them using List instead - e.g.

VBA Code:
    ' Job Number
    Me.cboJobNr.List= Application.Range("JobNr").Value
    Me.cboJobNr.AddItem SEARCH_BLANK
 
Upvote 1

Forum statistics

Threads
1,224,722
Messages
6,180,559
Members
452,987
Latest member
mrfitness_79

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top