Clearing Items in a Filtered Table from items selected on a Listbox

Qwest336

Board Regular
Joined
Jun 24, 2015
Messages
53
Hello everyone,

Background info:

I've created a workbook that I use to assign work. The worksheet that houses the data, named "Assigned", consists of 16 columns of data in a table. The information in the last three columns are submitted when the user highlights a row or data in a SingleItem selection listbox named "lboPHLData" on a userform and presses a command button captioned "Completed Action", named "cmdCompletedAction".

What I am trying to do is to allow the user to select an item in the listbox and add the last three columns of data on that worksheet. It then applies a filter that causes that data to be hidden based on the now present value in column 15. It will then open another workbook, filter that workbook down by the data in the first column (CombinedN), write that data into the last three columns of that workbook, save and close that workbook. All of that works fine...here's where the issue is. I want to reload the Listbox again using the same loop from the initialize event. However, I only want it to load Visible data into the listbox!

The code works if the user works from the bottom up because it doesn't cause data to be hidden in between the current selected row and the header row at the top. So if I assign 5 actions and the user completes them in 5-4-3-2-1 order, it works fine. However, when the user completes row 1 first (like, why would they want to start there? :ROFLMAO:), it doesn't work for the rows below as it continuously writes data to the now hidden (filtered) row.

Any help is greatly appreciated. Here is the current code below.

I am populating the listbox dynamically, one cell at a time on Initialize, not using a RowSource. Here is the Initialize Event:

Code:
Private Sub UserForm_Initialize()
Dim User As String 'Name
Dim User2 As String 'Email
Dim wk As Object
Dim TWB As String
Dim FTRColumns As String
Dim NonFTRColumns As String
User = Application.UserName
User2 = Environ("UserName")
TWB = ThisWorkbook.Name
Set wk = Workbooks(TWB).Worksheets("Assigned")
FTRColumns = "100 pt;160 pt;0 pt;0 pt;0 pt;0 pt;0 pt;140 pt;140 pt;120 pt"
NonFTRColumns = "80 pt;160 pt;160 pt;120 pt;100 pt;100 pt;100 pt;0 pt;0 pt;0 pt"
Me.txtActionsRemaining.Value = "Number of Actions Remaining: " & wk.Range("AO1").Value
Me.txtTodaysDate.Value = Format(Now, "Long Date")
'Adds AssignerName into textbox
Me.txtProcessorName.Value = User & " - " & User2
With usrPHLAssignment
    If Worksheets("Assigned").Range("L2") = "FTRDeclines" Then
        lboPHLData.ColumnWidths = FTRColumns
        frmFTRDeclines.Visible = True
        frmOtherAssignments.Visible = False
    ElseIf Worksheets("Assigned").Range("L2") <> "FTRDeclines" Then
        lboPHLData.ColumnWidths = NonFTRColumns
        frmFTRDeclines.Visible = False
        frmOtherAssignments.Visible = True
    End If
End With
 
Dim rng As Range
 On Error Resume Next
 Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlVisible)
 On Error GoTo 0
 If Not rng Is Nothing Then
 For Each cell In rng
 lboPHLData.AddItem cell.Value
 lboPHLData.List(lboPHLData.ListCount - 1, 1) = cell.Offset(0, 1)
 lboPHLData.List(lboPHLData.ListCount - 1, 2) = cell.Offset(0, 2)
 lboPHLData.List(lboPHLData.ListCount - 1, 3) = cell.Offset(0, 3)
 lboPHLData.List(lboPHLData.ListCount - 1, 4) = cell.Offset(0, 4)
 lboPHLData.List(lboPHLData.ListCount - 1, 5) = cell.Offset(0, 5)
 lboPHLData.List(lboPHLData.ListCount - 1, 6) = cell.Offset(0, 6)
 lboPHLData.List(lboPHLData.ListCount - 1, 7) = cell.Offset(0, 7)
 lboPHLData.List(lboPHLData.ListCount - 1, 8) = cell.Offset(0, 8)
 lboPHLData.List(lboPHLData.ListCount - 1, 9) = cell.Offset(0, 9)
 'lboPHLData.List(lboPHLData.ListCount - 1, 10) = Cell.Offset(0, 10)
 Next
 End If
End Sub

Here is the coding for the Click Event of the Completed Actions Button:
Code:
Private Sub cmdCompletedAction_Click()
Dim User As String 'Name
Dim User2 As String 'Email
Dim ProcessorName As String
Dim rr, rt As Double
Dim CombinedN As String
Dim wbPath As String
Dim CurrentRow As String
Dim TWB As String
Dim FindPerson As String
Dim ActiveRow As Double
User = Application.UserName
User2 = Environ("UserName")
ProcessorName = User & " - " & User2
wbPath = "T:\PHLAssignmentLog.xlsb"
TWB = ThisWorkbook.Name
Application.ScreenUpdating = False

rr = lboPHLData.ListIndex + 2 'Determines which row is selected. Adds 1 for the Table header and 1 because Listbox Index starts at 0

For i = rr To rr
    ActiveSheet.Range("O" & rr).Value = ProcessorName
    ActiveSheet.Range("P" & rr).Clear
    ActiveSheet.Range("P" & rr).Value = Format(Now, "mm/dd/yyyy hh:mm")
CombinedN = ActiveSheet.Range("A" & rr).Value & " - " & ActiveSheet.Range("B" & rr).Value
Next
'Finds the reference in the Assignment and corrects the Completion Date
    Workbooks("PHLAssignmentLog.xlsb").Sheets("Assigned").Activate
If Workbooks("PHLAssignmentLog.xlsb").Sheets("Assigned").ListObjects("Team4AssignedWork").ShowAutoFilter Then
    Workbooks("PHLAssignmentLog.xlsb").Sheets("Assigned").ListObjects("Team4AssignedWork").Range.AutoFilter
End If
    ActiveSheet.ListObjects("Team4AssignedWork").Range.AutoFilter Field:=1, _
        Criteria1:=CombinedN

Dim rn As Long
Dim rng As Range

    Set rng = Sheets("Assigned").Range("FilteredRange").SpecialCells(xlCellTypeVisible)
        rn = Sheets("Assigned").UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Row
'CurrentRow = Range("FilteredRange").Row
    ActiveSheet.Range("P" & rn).Value = ProcessorName
    ActiveSheet.Range("Q" & rn).Clear
    ActiveSheet.Range("Q" & rn).Value = Format(Now, "mm/dd/yyyy hh:mm")
Application.DisplayAlerts = False
Workbooks("PHLAssignmentLog.xlsb").Close SaveChanges:=True
Application.DisplayAlerts = True

Workbooks(TWB).Activate
    ActiveSheet.ListObjects("ProcessorAssignedWork").Range.AutoFilter Field:=15, _
        Criteria1:=""
Me.lboPHLData.Clear
 On Error Resume Next
 Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlVisible)
 On Error GoTo 0
 If Not rng Is Nothing Then
 For Each cell In rng
 lboPHLData.AddItem cell.Value
 lboPHLData.List(lboPHLData.ListCount - 1, 1) = cell.Offset(0, 1)
 lboPHLData.List(lboPHLData.ListCount - 1, 2) = cell.Offset(0, 2)
 lboPHLData.List(lboPHLData.ListCount - 1, 3) = cell.Offset(0, 3)
 lboPHLData.List(lboPHLData.ListCount - 1, 4) = cell.Offset(0, 4)
 lboPHLData.List(lboPHLData.ListCount - 1, 5) = cell.Offset(0, 5)
 lboPHLData.List(lboPHLData.ListCount - 1, 6) = cell.Offset(0, 6)
 lboPHLData.List(lboPHLData.ListCount - 1, 7) = cell.Offset(0, 7)
 lboPHLData.List(lboPHLData.ListCount - 1, 8) = cell.Offset(0, 8)
 lboPHLData.List(lboPHLData.ListCount - 1, 9) = cell.Offset(0, 9)
 'lboPHLData.List(lboPHLData.ListCount - 1, 10) = Cell.Offset(0, 10)
 Next
 End If
End If
Skip:
Application.ScreenUpdating = True
End Sub
 
Last edited:

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,214,650
Messages
6,120,734
Members
448,987
Latest member
marion_davis

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