PDA

View Full Version : Solved: Split variable across mult-column listbox



lucas
05-06-2006, 05:13 PM
I'm using this to populate a listbox:Initialize

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ListBox1.AddItem (ws.Name)
Next ws

can't figure out how to split these worksheet names across the columns...
first 20 in column 1, next 20 in column 2
For starters. May go more columns if number of sheets gets too high.
I've tried several things but not having any luck so far.

jindon
05-06-2006, 05:40 PM
Hi
something like this?

Private Sub UserForm_Initialize()
Dim ws As Worksheet, txt As String, a, myColWidth As String
For Each ws In Sheets
txt = txt & ws.Name & ","
Next
a = Split(Left(txt, Len(txt) - 1), ",")
myColWidth = Application.Rept("30;", Sheets.Count)
myColWidth = Left(myColWidth, Len(myColWidth) - 1)
With Me.ListBox1
.ColumnCount = Sheets.Count
.ColumnWidths = myColWidth
.Column = a
End With
End Sub

lucas
05-06-2006, 06:55 PM
Not quite Jindon. Not looking for 30 columns wide. Just 2 or 3 columns wide with 20 of the variable ws.Name in each column.....I'll look at your code a little closer for a clue. Thanks

jindon
05-06-2006, 07:24 PM
Right, I missed that part...

Private Sub UserForm_Initialize()
Dim ws As Worksheet, txt As String, a, myColWidth As String
Dim x, flag As Boolean
x = Application.RoundUp(Sheets.Count / 20, 0)
ReDim a(1 To x)
For Each ws In Sheets
i = i + 1
txt = txt & ws.Name & Chr(32)
If i = 20 Then
txt = Trim(txt) & ","
i = 0
End If
Next
On Error Resume Next
a = Split(txt, ",")
If UBound(a) = -1 Then
a = txt
Else
flag = True
End If
On Error GoTo 0
myColWidth = Application.Rept("300;", x)
myColWidth = Left(myColWidth, Len(myColWidth) - 1)
With Me.ListBox1
.ColumnCount = x
.ColumnWidths = myColWidth
If flag Then
.Column = a
Else
.AddItem a
End If
End With
End Sub

lucas
05-07-2006, 10:56 AM
I think we're on the right track but I'm still having trouble getting it to split...can't get data on row 2 etc..

Norie
05-07-2006, 11:13 AM
Steve

This worked for me.

Jindon

Hope you don't mind me borrowing the wee bit of code for the column width/count.:)

Private Sub UserForm_Initialize()
Dim ws As Worksheet, txt As String, a(), myColWidth As String
Dim x
x = Application.RoundUp(Sheets.Count / 20, 0)
myColWidth = Application.Rept("300;", x)
myColWidth = Left(myColWidth, Len(myColWidth) - 1)
r = 0: c = 0
With Me.ListBox1
.ColumnCount = x
.ColumnWidths = myColWidth

For Each ws In Sheets
ReDim Preserve a(19, c)
a(r, c) = ws.Name
r = r + 1
If r > 19 Then
r = 0: c = c + 1
End If
Next
.List = a
End With
End Sub

lucas
05-07-2006, 12:06 PM
Yes, thats breaking them into columns...I couldn't get the split to work.
Now I can try to figure (on click event)out how to select items in column 2 etc. as it is if I select an item in column 2 it still highlights the entire row...trying some property changes and will let you know. Thanks to Norie and Jindon for their insights and contributions.


Private Sub ListBox1_Click()
Dim i As Integer, sht As String
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
sht = ListBox1.List(i)
End If
Next i
Sheets(sht).Activate

End Sub

Norie
05-07-2006, 01:13 PM
Steve

What are you actually trying to do?

As far as I know you can't select individual columns in a listbox.

lucas
05-07-2006, 02:56 PM
I was beginning to come to the same conclusion. Thanks for verifying it for me Norie. At least now I know how to display data across rows in this manner. Marking this solved.

johnske
05-07-2006, 05:09 PM
Steve, for what it looks like you're trying to do, try... (but it only gives a single column :) )
Sub ActivateSheet()
On Error GoTo PopUp '< error = not enough sheets for 'MoreSheets' control
CommandBars("Workbook Tabs").Controls("More sheets...").Execute
Exit Sub
PopUp:
CommandBars("Workbook Tabs").ShowPopup
End Sub

lucas
05-07-2006, 06:34 PM
Yeah, I think I was out of school on this on John...I'm actually working on the inventrory file that you posted oh so long ago. I use it exclusivly...probably owe you some dough for it.

I wound up with so many sheets that I was using Zacks Navigation listbox and my column was getting pretty tall....so I thought....but na, not this time I guess. Sure appreciate all the help. I did learn a thing or two.

jindon
05-08-2006, 05:13 PM
Steve

I couldn't get the split to work
Are you on '97?
if so,
use following code to Split function to work as well as Join function

Function Split(Expression, Optional delimiter, _
Optional limit As Long = -1, Optional Compare As Long)
Dim x(), i As Long, n As Long, y As Long
ReDim x(0)
If limit = 0 Or Expression = "" Then Split = x: Exit Function
Expression = CStr(Expression)
If limit = 1 Then _
x(0) = Expression: Split = x: Exit Function
If IsMissing(delimiter) Then delimiter = Chr(32)

y = Len(delimiter)
i = 1
Do
If StrComp(Mid(Expression, i, y), delimiter, Comparex) = 0 Then
ReDim Preserve x(n)
x(n) = Left(Expression, i - 1)
Expression = Right(Expression, Len(Expression) - i - y + 1)
n = n + 1
If limit <> -1 Then _
If n >= limit - 1 Then Exit Do
i = 0
End If
i = i + 1
Loop Until i > Len(Expression)
If Len(Expression) Then
ReDim Preserve x(n)
x(n) = Expression
End If
Split = x
End Function

Function Join(SourceArray, Optional delimiter) As String
Dim e As Variant
On Error GoTo Last
If UBound(SourceArray) = -1 Then Exit Function
If IsMissing(delimiter) Then delimiter = Chr(32)
For Each e In SourceArray
Join = Join & e & delimiter
Next
Join = Left(Join, Len(Join) - Len(delimiter))
Last:
End Function


Norie,
No, I don't mind at all. Please do anytime.

lucas
05-08-2006, 05:23 PM
No Jindon, I'm using 2003 but I'm going to save your code for reference...thanks