populate ListBox depending on values in two columns

[johnsonk]

Hi,
I am trying to populate a listbox in a userform that ignores the value 0 in two colums C & D so it only populates the listbox with the rows that have a value greater than 0 in columns C & D. The image is an example of the data so what I would need from that is to just show the two rows. Hope this makes sense.

Regards

Also posted here Populate listbox in userform from worksheet ignoring 0 from two columns - OzGrid Free Excel/VBA Help Forum

 

[johnsonk]

Hi, I managed to get the formula to work from the last column +1 but I'm still getting the autofilter error.

 

[NoSparks]

your range to filter is no longer .cells(1).currentregion
it now starts at A6 and goes to last row (lr) and the column with the formulas (lc + 1)

 

[johnsonk]

I have made the changes but still getting the error, this is so confusing me right now.

[/B]
Private Sub UserForm_Initialize()
Worksheets("ALL").Unprotect "?????"
With Application
.WindowState = xlMaximized
Zoom = Int(.Width / Me.Width * 85)
Width = .Width
Height = .Height
End With
    Dim lr As Long, lc As Long
Dim filtrng As Range

Application.ScreenUpdating = False
With ThisWorkbook.Sheets("ALL")
'remove any existing filters
If .FilterMode Then .ShowAllData
'determine last row
lr = .Range("A" & .Rows.Count).End(xlUp).Row
'determine last column
lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
'put formula in next column
Range(.Cells(7, lc + 19), .Cells(lr, lc + 19)).FormulaR1C1 = "=RC[-2]+RC[-1]"
'filter on new column
Set filtrng = .Cells(6).CurrentRegion
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With filtrng
.AutoFilter Field:=lc + 19, Criteria1:="<>0"
'check that count of filtered rows isn't zero
If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 = 0 Then
'remove filter
.AutoFilter
'remove added column contents
Columns(lc + 19).ClearContents
Exit Sub
End If
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End With

'add temp sheet to copy to
Sheets.Add
With ActiveSheet
.Name = "Scratchpad"
filtrng.Offset(1).Resize(lr - 1, lc).Copy
.Paste
'populate list box
Me.ListBox1.List = Sheets("Scratchpad").Cells(6).CurrentRegion.Value
'remove sheet
Application.DisplayAlerts = False
Sheets("Scratchpad").Delete
Application.DisplayAlerts = True
End With
'restore sheet1 to original
With ThisWorkbook.Sheets("ALL")
'remove filter
filtrng.AutoFilter
'clear the added column
.Columns(lc + 19).ClearContents
End With

Application.ScreenUpdating = True
Worksheets("ALL").Protect "?????"
End Sub
[B]

 

[NoSparks]

Private Sub UserForm_Initialize()
    Dim lr As Long, lc As Long
    Dim filtrng As Range
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("ALL")
    If .FilterMode Then .ShowAllData
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    lc = .Cells(6, .Columns.Count).End(xlToLeft).Column
    Range(.Cells(7, lc + 1), .Cells(lr, lc + 1)).FormulaR1C1 = "=RC[-2]+RC[-1]"
    Set filtrng = .Range("A6", .Cells(lr, lc + 1))
    With filtrng
        .AutoFilter Field:=lc + 1, Criteria1:="<>0"
        If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 = 0 Then
            .AutoFilter
            Columns(lc + 1).ClearContents
            Exit Sub
        End If
    End With
End With
Sheets.Add
With ActiveSheet
    .Name = "Scratchpad"
    filtrng.Offset(1).Resize(lr - 1, lc).Copy
    .Paste
    Me.ListBox1.List = Sheets("Scratchpad").Cells(1).CurrentRegion.Value
    Application.DisplayAlerts = False
    Sheets("Scratchpad").Delete
    Application.DisplayAlerts = True
End With
With ThisWorkbook.Sheets("ALL")
    filtrng.AutoFilter
    .Columns(lc + 1).ClearContents
End With
Application.ScreenUpdating = True
End Sub

sample file

 

[johnsonk]

Thank you NoSparks but unfortunately am getting the error

from the line below

Me.ListBox1.List = Sheets("Scratchpad").Cells(1).CurrentRegion.Value

I have noticed the code now has the line - Set filtrng = .Range("A6", .Cells(lr, lc + 1))
where before it had - Set filtrng = .Cells(1).CurrentRegion
could this be the reason for the error.

 

[NoSparks]

Are you getting that error in the file I linked to or in another file ?

 

[johnsonk]

Sorry did not notice the link, but by using your link I have now got my form working perfect again. Thank you NoSpark for being patient and helping me getting it working again.