populate ListBox depending on values in two columns

johnsonk

Board Regular
Joined
Feb 4, 2019
Messages
172
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.

1602763891609.png


Regards

Also posted here Populate listbox in userform from worksheet ignoring 0 from two columns - OzGrid Free Excel/VBA Help Forum
 
Last edited by a moderator:
Sorry yes happy with the combobox.
Just noticed one thing with the listbox when all the values in colummns C & D are 0 the listbox displays all the data from the sheet is there a way of leaving the listbox blank when all the values are 0. Sorry to be a pain.
 
Upvote 0

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sorry, never even checked for that.
Alteration to code
Rich (BB code):
    With filtrng
        .AutoFilter field:=lc + 1, 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 + 1).ClearContents
            Exit Sub
        End If
    End With
 
Upvote 0
Hi,

I can not get it to work have I put the extra coding you provided in the right place ?

VBA Code:
Private Sub UserForm_Initialize()

    Dim lr As Long, lc As Long
    Dim filtrng As Range
    
Application.ScreenUpdating = False

With ThisWorkbook.Sheets("Data")
    '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(2, lc + 1), .Cells(lr, lc + 1)).FormulaR1C1 = "=RC[-2]+RC[-1]"
    'filter on new column
    Set filtrng = .Cells(1).CurrentRegion
    With filtrng
        .AutoFilter Field:=lc + 1, Criteria1:="<>0"
    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(1).CurrentRegion.Value
    'remove sheet
    Application.DisplayAlerts = False
    Sheets("Scratchpad").Delete
    Application.DisplayAlerts = True
End With

'restore sheet1 to original
With ThisWorkbook.Sheets("Data")
    'remove filter
    filtrng.AutoFilter
    'If .FilterMode Then .ShowAllData
    'clear the added column
    .Columns(lc + 1).ClearContents
End With
With filtrng
        .AutoFilter Field:=lc + 1, 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 + 1).ClearContents
            Exit Sub
        End If
    End With
Application.ScreenUpdating = True

End Sub
 
Upvote 0
No, that's not the right place.
The red lines needed to be inserted into the With filtrng part to determine right away if there were any results from the filtering.

VBA Code:
Private Sub UserForm_Initialize()
    Dim lr As Long, lc As Long
    Dim filtrng As Range
    
Application.ScreenUpdating = False

With Sheet1
    '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(2, lc + 1), .Cells(lr, lc + 1)).FormulaR1C1 = "=RC[-2]+RC[-1]"
    'filter on new column
    Set filtrng = .Cells(1).CurrentRegion
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    With filtrng
        .AutoFilter field:=lc + 1, 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 + 1).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(1).CurrentRegion.Value
    'remove sheet
    Application.DisplayAlerts = False
    Sheets("Scratchpad").Delete
    Application.DisplayAlerts = True
End With

'restore sheet1 to original
With Sheets("Sheet1")
    'remove filter
    filtrng.AutoFilter
    'clear the added column
    .Columns(lc + 1).ClearContents
End With
            
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Hi, Could I ask for you assistance again please, I have had to change the sheet data which now has more columns and now I can not get the code to work. The original sheet populated the listbox with columns A,B,C,D and I need the new sheet to populate columns A,B,C,R,S, any help would be much appreciated.

ORIGINAL SHEET WITH 4 COLUMS STARTING FROM CELL A2 WHICH WORKED PERFECT
View attachment 24627

NEW SHEET NOW WITH 19 COLUMNS STARTING FROM CELL A7
1603368064543.png




VBA Code:
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(2, lc + 1), .Cells(lr, lc + 1)).FormulaR1C1 = "=RC[-2]+RC[-1]"
'filter on new column
Set filtrng = .Cells(1).CurrentRegion
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With filtrng
.AutoFilter Field:=lc + 1, 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 + 1).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(1).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 + 1).ClearContents
End With

Application.ScreenUpdating = True
Worksheets("ALL").Protect "?????"
End Sub
 
Upvote 0
Hi,
I have tried altering the line below

Range(.Cells(2, lc + 1), .Cells(lr, lc + 1)).FormulaR1C1 = "=RC[-2]+RC[-1]"

to
Range(.Cells(7, lc + 1), .Cells(lr, lc + 1)).FormulaR1C1 = "=RC[-2]+RC[-1]"

but I just get
1603378972847.png
 
Upvote 0
Are you reading the comments I put in the code ?
How did you calculate lc ?
 
Upvote 0
Does this not start at cell 7 to the last column +1 then do the formula ? if not I have no idea

Range(.Cells(7, lc + 1), .Cells(lr, lc + 1)).FormulaR1C1 = "=RC[-2]+RC[-1]"
 
Upvote 0

Forum statistics

Threads
1,214,823
Messages
6,121,779
Members
449,049
Latest member
greyangel23

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