Friends,

Here is a screen shot of my workbook.

Pic.png

I need to create a "Closeout Job" function and I don't know how to go about it. This work book has a ton of entries so I need to start weeding it out. I don't need this list to contain completed jobs but I do need a record of them. I would like to be able to use the filter funtion to select a particular job... Export those entries to a PDF to keep for records and then delete all of those specific entries from the master list.

Here is my filter code and screen shot post filter.

pic2.png


Option Explicit

Dim rngData As Range

Private Sub AnsweredAdd_Click()
AddFilter "AnsweredCombo", "AnsweredList"
End Sub

Private Sub AnsweredDelete_Click()
RemoveFilter "AnsweredList"
End Sub

Private Sub AssignedAdd_Click()
AddFilter "AssignedCombo", "AssignedList"
End Sub

Private Sub AssignedDelete_Click()
RemoveFilter "AssignedList"
End Sub

Private Sub BICAdd_Click()
AddFilter "BICCombo", "BICList"
End Sub

Private Sub BICDelete_Click()
  RemoveFilter "BICList"
End Sub


Private Sub CommandButton1_Click()
ApplyFilter True
End Sub

Private Sub ContractorAdd_Click()
AddFilter "ContractorCombo", "ContractorList"
End Sub

Private Sub ContractorDelete_Click()
RemoveFilter "ContractorList"
End Sub

Private Sub CSJAdd_Click()
AddFilter "CSJCombo", "CSJList"
End Sub

Private Sub CSJDelete_Click()
RemoveFilter "CSJList"
End Sub

Private Sub HighwayAdd_Click()
AddFilter "HighwayCombo", "HighwayList"
End Sub

Private Sub HighwayDelete_Click()
RemoveFilter "HighwayList"
End Sub
Private Sub ProjectAdd_Click()
AddFilter "ProjectCombo", "ProjectList"
End Sub

Private Sub ProjectDelete_Click()
RemoveFilter "ProjectList"
End Sub


Private Sub UserForm_Initialize()
    With ActiveWorkbook.ActiveSheet
        Set rngData = .Range("A5", .Cells(Rows.Count, "M").End(xlUp))
        ApplyFilter
    End With
End Sub

Private Function ApplyFilter(Optional ByVal bKeepFilter As Boolean = False)
    
    Dim ctrl As Control
    Dim wsList As Worksheet
    Dim VisCell As Range
    Dim colList As Object
    Dim arrList() As Variant
    Dim arrFilterData() As Variant
    Dim i As Long, j As Long
    Dim strCBO As String
    
    Set wsList = Sheets("Lists")
    Application.ScreenUpdating = False
    
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ListBox" Then
            If ctrl.ListCount > 0 Then
                ReDim arrFilterData(1 To ctrl.ListCount)
                For i = 1 To ctrl.ListCount
                    arrFilterData(i) = ctrl.List(i - 1)
                Next i
                rngData.AutoFilter ctrl.Tag, arrFilterData, xlFilterValues
                Erase arrFilterData
            End If
        End If
    Next ctrl
    
    If bKeepFilter = False Then
        On Error Resume Next
        For i = 1 To 7
            strCBO = Choose(i, "CSJCombo", "ProjectCombo", "HighwayCombo", "ContractorCombo", "BICCombo", "AssignedCombo", "AnsweredCombo")
            Set colList = New Collection
            For Each VisCell In rngData.Offset(, Me.Controls(strCBO).Tag - 1).Resize(, 1).SpecialCells(xlCellTypeVisible).Cells
                If VisCell.Row > 5 Then
                    colList.Add VisCell.Text, VisCell.Text
                End If
            Next VisCell
            With Me.Controls(strCBO)
                .Clear
                If colList.Count > 0 Then
                    ReDim arrList(1 To colList.Count)
                    For j = 1 To colList.Count
                        arrList(j) = colList(j)
                    Next j
                    With wsList.Range("A1").Resize(UBound(arrList))
                        .Value = Application.Transpose(arrList)
                        .Sort .Cells, xlAscending, Header:=xlNo
                        arrList = Application.Transpose(.Value)
                        .ClearContents
                    End With
                    .List = arrList
                    Erase arrList
                End If
            End With
            Set colList = Nothing
        Next i
        On Error GoTo 0
        
        rngData.AutoFilter
        Set wsList = Nothing
        Application.ScreenUpdating = True
    Else
        Application.ScreenUpdating = True
        Unload Me
    End If
    
End Function

Private Function AddFilter(ByVal strCBO As String, ByVal strList As String)
    
    With Me.Controls(strCBO)
        If .ListIndex > -1 Then
            Me.Controls(strList).AddItem .List(.ListIndex)
            ApplyFilter
        End If
    End With
    
End Function

Private Function RemoveFilter(ByVal strList As String, Optional ByVal bClearAll As Boolean = False)
    
    Dim i As Long
    
    With Me.Controls(strList)
        If bClearAll = False Then
            If .ListIndex > -1 Then
                .RemoveItem .ListIndex
                ApplyFilter
            End If
        Else
            For i = .ListCount - 1 To 0 Step -1
                .RemoveItem i
            Next i
            ApplyFilter
        End If
    End With
    
End Function


How would I go about doing something like that?

Thanks in advance,

Mike