• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Clearing items in a filtered table using selected items in a Listbox

Qwest336

New Member
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?
icon_rofl.gif
), 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

Any help is greatly appreciated!
 
It is a bit tough to help without example file(s).

I would probably use List to fill the Listbox. When something like AutoFilter is used, one will need SpecialCells(xlTypeVisible) and either a scratch worksheet or an array method to fill the List. If you set one of your column widths to 0, you can hide the value for the external address. That will let you know which workbook, worksheet, and cell(s) that row would represent.

Rather than reference the other forum thread where I did that for an example, I have attached that sample file.
 

Attachments

  • Log-01-Filter-03_Ken2.xlsm
    235.2 KB · Views: 12
It is a bit tough to help without example file(s).

I would probably use List to fill the Listbox. When something like AutoFilter is used, one will need SpecialCells(xlTypeVisible) and either a scratch worksheet or an array method to fill the List. If you set one of your column widths to 0, you can hide the value for the external address. That will let you know which workbook, worksheet, and cell(s) that row would represent.

Rather than reference the other forum thread where I did that for an example, I have attached that sample file.

Thanks for the response, Ken. Sorry that I did not upload a file...but I have to go through verification that it's properly scrubbed first. Hopefully I'll be done with that headache in a bit.

I have since changed the coding so that it works from top down...but only as long as the user doesn't skip a line! Basically, I used the following code to set a line as the line the user selected ListIndex, Add 2 rows to account for the header row on the sheet and the fact that ListBox's start at row 0, and then take the difference between an CountA of the Range and the ListCount value to determine how many have already been completed.

Code:
rr = lboPHLData.ListIndex + 2 + (AssignTotal - Me.lboPHLData.ListCount)

However, the best way would clearly be to find the action, determine the current row for that action, and then pass that as the "rr" value so that I can fill the two columns, O & P.

I can't use Application.Find because there may be duplicate Req#s and/or Names in the table.

Any thoughts?
 
Hey Ken...I think sometimes you guys just pass this information through interwebs osmosis! After talking it out a bit, a solution became clear.

1)I added a column to the end of the table to concatenate the first two columns together...this ensures I have a unique combination.

2)I used a combination of the .Text and the .Value (Bound Column) properties of the Listbox to mimic that same value as a String.

3)I then used Range.Find to locate that value inside of a NamedRange (created with an Offset to account for a variable amount of rows on the sheet) and returned that row.

This obviously works because it will find the value in the table and the current row will be determined by the selection of that cell.

Here's the offset for the named range:
Combined =
Code:
=OFFSET(Assigned!$Q$1,1,0,COUNTA(Assigned!$Q:$Q)-1,1)

Here's the code:

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 TWB As String
Dim FindPerson As String
Dim ActiveRow As Double
Dim AssignTotal As Double
Dim CombinedTogether As String

User = Application.UserName
User2 = Environ("UserName")
ProcessorName = User & " - " & User2
wbPath = "T:\PHLAssignmentLog.xlsb"
TWB = ThisWorkbook.Name

Application.ScreenUpdating = False

CombinedTogether = Me.lboPHLData.Value & " - " & Me.lboPHLData.Text


Dim rgFound As Range
Set rgFound = Range("Combined").Find(CombinedTogether)
rr = rgFound.Row

For i = rr To rr
  Workbooks(TWB).Sheets("Assigned").Range("O" & rr).Value = ProcessorName
  Workbooks(TWB).Sheets("Assigned").Range("P" & rr).Clear
  Workbooks(TWB).Sheets("Assigned").Range("P" & rr).Value = Format(Now, "mm/dd/yyyy hh:mm")

CombinedN = Workbooks(TWB).Sheets("Assigned").Range("A" & rr).Value & " - " & Workbooks(TWB).Sheets("Assigned").Range("B" & rr).Value

Next

'Finds the reference in the Assignment and corrects the Completion Date

Workbooks.Open Filename:=wbPath
  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 = Workbooks("PHLAssignmentLog.xlsb").Sheets("Assigned").Range("FilteredRange").SpecialCells(xlCellTypeVisible)
  rn = Workbooks("PHLAssignmentLog.xlsb").Sheets("Assigned").UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).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

  Workbooks(TWB).Sheets("Assigned").ListObjects("ProcessorAssignedWork").Range.AutoFilter Field:=15, _
  Criteria1:=""


Me.lboPHLData.Clear
 On Error Resume Next
 Set rng = Workbooks(TWB).Sheets("Assigned").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

Skip:
Application.ScreenUpdating = True

End Sub


Thanks for all of your help and your sample file! Hopefully me overly complicating the solution will help someone else not do the same in the future. :)
 
Back
Top