Populate worksheet combobox with non blank cells

[kelly mort]

Hi,

I came up with this code online, it's not doing exactly what I wanted.

I need someone fix it for me.


This is what I want:

I want to load non blank cells from the column B into the listbox

<code style="box-sizing: inherit; margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace; vertical-align: baseline; max-height: 300px; overflow: auto;">[COLOR=#101094]Sub[/COLOR][COLOR=#303336] LoadNonBlanks[/COLOR][COLOR=#303336]()[/COLOR][COLOR=#303336]
    [/COLOR][COLOR=#101094]Dim[/COLOR][COLOR=#303336] rng [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#303336] Range[/COLOR][COLOR=#303336],[/COLOR][COLOR=#303336] r [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#303336] Range[/COLOR][COLOR=#303336],[/COLOR][COLOR=#303336] rSel [/COLOR][COLOR=#101094]As[/COLOR][COLOR=#303336] Range
    Dim arr As Variant 

    [/COLOR][COLOR=#101094]Set[/COLOR][COLOR=#303336] rng [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] Range[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"B3:B103"[/COLOR][COLOR=#303336])[/COLOR][COLOR=#303336]
    [/COLOR][COLOR=#101094]Set[/COLOR][COLOR=#303336] rSel [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#7D2727]Nothing[/COLOR][COLOR=#303336]

    [/COLOR][COLOR=#101094]For[/COLOR][COLOR=#101094]Each[/COLOR][COLOR=#303336] r [/COLOR][COLOR=#101094]In[/COLOR][COLOR=#303336] rng
        [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] r[/COLOR][COLOR=#303336].[/COLOR][COLOR=#303336]Value [/COLOR][COLOR=#303336]<>[/COLOR][COLOR=#7D2727]""[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
            [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336] rSel [/COLOR][COLOR=#101094]Is[/COLOR][COLOR=#7D2727]Nothing[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336]
                [/COLOR][COLOR=#101094]Set[/COLOR][COLOR=#303336] rSel [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] r
            [/COLOR][COLOR=#101094]Else[/COLOR][COLOR=#303336]
                [/COLOR][COLOR=#101094]Set[/COLOR][COLOR=#303336] rSel [/COLOR][COLOR=#303336]=[/COLOR][COLOR=#303336] Union[/COLOR][COLOR=#303336]([/COLOR][COLOR=#303336]rSel[/COLOR][COLOR=#303336],[/COLOR][COLOR=#303336] r[/COLOR][COLOR=#303336])[/COLOR][COLOR=#303336]
            [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
        [/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]If[/COLOR][COLOR=#303336]
    [/COLOR][COLOR=#101094]Next[/COLOR][COLOR=#303336] r
    [/COLOR][COLOR=#101094]If[/COLOR][COLOR=#101094]Not[/COLOR][COLOR=#303336] rSel [/COLOR][COLOR=#101094]Is[/COLOR][COLOR=#7D2727]Nothing[/COLOR][COLOR=#101094]Then[/COLOR][COLOR=#303336] arr = rSel 
[/COLOR][COLOR=#303336]  MyCmb.clear 
MyCmb.List = arr
[/COLOR][COLOR=#101094]End[/COLOR][COLOR=#101094]Sub[/COLOR]</code>

It's filling then breaking at the blanks.

It can't pick it as I wanted.

 

[dmt32]

Hi,
untested but see if this update to your code helps

Sub LoadNonBlanks()
    Dim rng As Range, cell As Range
    Dim arr() As Variant
    Dim i As Integer


    Set rng = Range("B3:B103")


    For Each cell In rng.Cells
        If Len(cell.Value) > 0 Then
            i = i + 1
            ReDim Preserve arr(1 To i)
            arr(i) = cell.Value
        End If
    Next cell


    With MyCmb
     If i > 0 Then .Clear: .List = arr
    End With
End Sub

Dave

 

[kelly mort]

Hi,
untested but see if this update to your code helps

Sub LoadNonBlanks()
    Dim rng As Range, cell As Range
    Dim arr() As Variant
    Dim i As Integer


    Set rng = Range("B3:B103")


    For Each cell In rng.Cells
        If Len(cell.Value) > 0 Then
            i = i + 1
            ReDim Preserve arr(1 To i)
            arr(i) = cell.Value
        End If
    Next cell


    With MyCmb
     If i > 0 Then .Clear: .List = arr
    End With
End Sub

Dave

Great! !!


It worked.


Thanks for it

 

[kelly mort]

Hi,
untested but see if this update to your code helps

Sub LoadNonBlanks()
    Dim rng As Range, cell As Range
    Dim arr() As Variant
    Dim i As Integer


    Set rng = Range("B3:B103")


    For Each cell In rng.Cells
        If Len(cell.Value) > 0 Then
            i = i + 1
            ReDim Preserve arr(1 To i)
            arr(i) = cell.Value
        End If
    Next cell


    With MyCmb
     If i > 0 Then .Clear: .List = arr
    End With
End Sub

Dave

Hello,

I have another need:


Is there a way a can eliminate duplicate as well?

So when the item appears more than once I take only one.


If I have to start a new thread for this please let me know.

Thanks

 

[Fluff]

How about

Sub kellymort()
    Dim Cl As Range

   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B3:B103")
         If Cl <> "" Then .Item(Cl.Value) = Empty
      Next Cl
      mycmb.Clear
      mycmb.List = .Keys
   End With
End Sub

 

[kelly mort]

How about

Sub kellymort()
    Dim Cl As Range

   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B3:B103")
         If Cl <> "" Then .Item(Cl.Value) = Empty
      Next Cl
      mycmb.Clear
      mycmb.List = .Keys
   End With
End Sub

And the reply was quicker than expected !!!!


Thanks @Fluff

 

[Fluff]

You're welcome & thanks for the feedback

 

[dmt32]

Hello,

I have another need:


Is there a way a can eliminate duplicate as well?

So when the item appears more than once I take only one.


If I have to start a new thread for this please let me know.

Thanks

Popular approach to this requirement seems be to use Scripting Dictionary but as an idea, see if this update to code will do what you want.

Sub LoadNonBlanks()
    Dim rng As Range, cell As Range
    Dim arr() As Variant
    Dim i As Integer


    Set rng = Range("B3:B103")
    
    ReDim arr(1)
    For Each cell In rng.Cells
        If Len(cell.Value) > 0 Then
        If IsError(Application.Match(cell.Value, arr, 0)) Then
            ReDim Preserve arr(i)
            arr(i) = cell.Value
            i = i + 1
        End If
        End If
    Next cell


    With MyCmb
        .Clear: .List = arr
    End With
End Sub

Dave

 

[kelly mort]

Thanks @dmt32,

It worked great.

I am really excited to be here.

Expanding my knowledge base .