Fill Listbox with Multiple Ranges

[mucah!t]

Hi all,

Is it possible to fill a ActiveX Listbox with multiple dynamic ranges?
[ie; A4-C10, D4-F18, G4-I9]

 

[MickG]

If you want the List one complete column at a time , try this.

[COLOR="Navy"]Sub[/COLOR] MG12Sep58
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray     [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ac      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] A       [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A4:C10,D4:F18,G4:I9")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] A [COLOR="Navy"]In[/COLOR] Rng.Areas
    Ray = Application.Transpose(Application.Transpose(A.Value))
        [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
            [COLOR="Navy"]For[/COLOR] Rw = 1 To UBound(Ray, 1)
                [COLOR="Navy"]If[/COLOR] Ray(Rw, Ac) <> "" [COLOR="Navy"]Then[/COLOR]
                    ListBox1.AddItem Ray(Rw, Ac)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Rw
        [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]Next[/COLOR] A
    
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mucah!t]

This awesome Mick, but not yet what I had in mind.
Perhaps below example clarifies it.

A1	B1	C1	D1	E1	F1
MIKE	ALFA	21	RICK	KILO	143
JOHN	BRAVO	54	MATTHEW	LIMA	12
LEX	CHARLIE	13	LEX	MIKE	36
PETER	DELTA	87			
					
					
LISTBOX					
MIKE	ALFA	21			
JOHN	BRAVO	54			
LEX	CHARLIE	13			
PETER	DELTA	87			
RICK	KILO	143			
MATTHEW	LIMA	12			
LEX	MIKE	36

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG12Sep50
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray     [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] A       [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] cl      [COLOR="Navy"]As[/COLOR] Range
c = 1
'[COLOR="Green"][B]Set Rng = Range("A4:C10,D4:F18,G4:I9")[/B][/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2:C5,D2:F4")
ReDim Ray(1 To Rng.Count, 1 To Rng.Columns.Count)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] A [COLOR="Navy"]In[/COLOR] Rng.Areas
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] cl [COLOR="Navy"]In[/COLOR] A
    [COLOR="Navy"]If[/COLOR] cl <> "" [COLOR="Navy"]Then[/COLOR]
    n = n + 1
    c = c + IIf(n = A.Columns.Count + 1, 1, 0)
    n = IIf(n = A.Columns.Count + 1, 1, n)
    Ray(c, n) = cl
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] cl
[COLOR="Navy"]Next[/COLOR] A
  
[COLOR="Navy"]With[/COLOR] ListBox1
  .ColumnCount = 3
  .ColumnWidths = "50,50,50"
  ListBox1.List = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mucah!t]

This one gives an error:

Run-time error "70":
Permission denied

 

[MickG]

I would say you have placed a range in the "ListFillRange" property.
If so remove it !!

 

[mucah!t]

It works great Mick.
This is really awesome!
Thank you very much for your help!

 

[mucah!t]

Hello Mick,

I had it working, but for some reason it does not work any longer.
It is stored in a module: [see below]
But running it gives "run-time error 424" "object required"

Sub test()
Dim Rng     As Range
Dim Ray     As Variant
Dim A       As Range
Dim n       As Integer
Dim c       As Long
Dim cl      As Range
c = 1

With Sheets("Dbase")
Set Rng = .Range("I2:K30,L2:N30")
End With

ReDim Ray(1 To Rng.Count, 1 To Rng.Columns.Count)
For Each A In Rng.Areas
   For Each cl In A
    If cl <> "" Then
    n = n + 1
    c = c + IIf(n = A.Columns.Count + 1, 1, 0)
    n = IIf(n = A.Columns.Count + 1, 1, n)
    Ray(c, n) = cl
End If
Next cl
Next A
  
With Listbox2
  .ColumnCount = 3
  .ColumnWidths = "120,40,40"
  Listbox2.List = Ray
End With
End Sub

Any idea?

 

[MickG]

I don't know what the problem is, it works for me, does the code stop on any particular line.
Have you changed anything on the sheet or code.????
Instead of running it from a module , would it help if you ran from the sheet "Activate Event", then the Listbox would be full when you opened the sheet.

Private Sub Worksheet_Activate()
Dim Rng     As Range
Dim Ray     As Variant
Dim A       As Range
Dim n       As Integer
Dim c       As Long
Dim cl      As Range
c = 1
With Sheets("Dbase")
Set Rng = .Range("I2:K30,L2:N30")
End With
ReDim Ray(1 To Rng.Count, 1 To Rng.Columns.Count)
For Each A In Rng.Areas
   For Each cl In A
    If cl <> "" Then
    n = n + 1
    c = c + IIf(n = A.Columns.Count + 1, 1, 0)
    n = IIf(n = A.Columns.Count + 1, 1, n)
    Ray(c, n) = cl
End If
Next cl
Next A
  
With ActiveSheet.ListBox2
  .ColumnCount = 3
  .ColumnWidths = "120,40,40"
  ActiveSheet.ListBox2.List = Ray
End With
End Sub

Mick

 

[mucah!t]

I used your suggested code.
Although it does not update upon opening it does not give an error when I run the code from VB?
So it now works when runned from VB.

 

[mucah!t]

Can I call/run a "Private sub"-macro from a commandutton?