Listobject .listcolumns in for loop

Desantech

New Member
Joined
Jun 26, 2018
Messages
17
Hello
Im am stucked, really tried hard to find out, since I am a newbee (not sooo new, but quite weak) I try to find a solution during learning by doing on my project
I know this is nasty and long, but the aim is simple:
Using Listobject on sheet I have:
1 userform
1 Listbox
11 checkboxes
1 textbox

I tried to "comment" in the VBA code what i tryy to do.

My aim is to get a listbox show the columns of a listobject according to the checkboxes. I am really new, no idea o programming, but did a lot today, I couldnt get it to work.
I know the code is nasty, I will simpify it, first need the tricks how to lol


VBA Code:
Private Sub UserForm_Initialize()

Dim z As Integer
Dim alpha() As Variant
Dim x As Long
Dim i As Integer
Dim a As Variant


'_________________________________________________________________ SETUP CHECKBOXES (checkbox names are Checkbox1 to Checkbox11)


Set a = Sheets("Einstellungen_Asuche")

' On Userform "Artikelsuche2" I have 11 Checkboxes, and according to the values on sheet "a" Range M2:M12, I set the Checkboxes to true or false (there are the values stored)

With Artikelsuche2
    For i = 1 To 11
        .Controls("Checkbox" & i) = a.Range("M" & i + 1).Value
    Next i
End With
                        
' I set a counter "z" to see how many on the sheet "a" range "M+i" are true (I will get rid of this later on)

z = 1

For i = 1 To 11
    If a.Range("M" & i + 1).Value = True Then
        z = z + 1
    End If
Next i

' I correct the value because of i, z show me how many are truely TRUE

z = z - 1

'_________________________________________________________________ How many Columns to be shown in the listbox

' I set Listbox1 Columncount to number of "z" on Userform Artikelsuche2 (?)
    Artikelsuche2.ListBox1.ColumnCount = z
    
' I set a static pt width of each column (?)
    Artikelsuche2.ListBox1.ColumnWidths = "100"

' I give a name "myTable" to the Listobject found on sheet "Artikelsuche_Temp" called "myTable_Source")
    
    Set myTable = Worksheets("ArtikelSuche_Temp").ListObjects("myTable_Source")
    
' So, "myarray" will be the databodyrange of "myTable" that is the name variable of listobject "mytable_sourc"e what has a range of "A2:I234" in this case
    myarray = myTable.DataBodyRange

' here I am just testing and trying to figure out how to get the values done, like if Checbox 8 is marked, but nbothing else, it goes to Z = 8 and do something. I will get rid of this also
' for now, lets see if 4 checkboyes are checked TRUE, so lets jump to Z = 4:


'==============> SKIP

'If z = 1 Then
 '           For i = 1 To 11
  '          If a.Range("M" & i + 1).Value = True Then
   '
    '        myArray2 = myTable.ListColumns(i + 1).DataBodyRange
     '
      '      End If
       '     Next i
            
            
'ElseIf z = 2 Then
'
 '           myArray2 = Union(myTable.ListColumns(2).DataBodyRange, _
  '                      myTable.ListColumns(3).DataBodyRange)

'ElseIf z = 3 Then
 '
  '          ReDim alpha(0 To 11)
   '
    '        For i = 1 To 11
     '
      '          If a.Range("M" & i + 1).Value = True Then
       '
        '        alpha(x) = i + 1
'                x = x + 1
 '
  '          End If
   '         Next i
    '
     '       myArray2 = Union(myTable.ListColumns(alpha(0)).DataBodyRange, _
      '                  myTable.ListColumns(alpha(1)).DataBodyRange, _
       '                 myTable.ListColumns(alpha(2)).DataBodyRange)
                        
'<===============SKIP

'so if 4 checkboxes are Turned on, then we get here
'(this can be checkbox 1/4/7/9)

ElseIf z = 4 Then

            ReDim alpha(0 To 11)
            
' I start a counter from 1 to 11
            For i = 1 To 11
            
' If the "stored range" on sheet "a" are true, then I put into alpha array the value it found the true value on, and increase to next array (x+1) before moving on to next i
                If a.Range("M" & i + 1).Value = True Then
                    alpha(x) = i + 1
                x = x + 1
            End If
            Next i
        
' Here the problem occurs:
' As I have the listcolumns (alpha numbers) okay, regarding to what I want, this UNION doesnt put the columns into it, only then, if the columns are next to eachother, exampl: col 1-2-3-4, but not 1-4-6-9

            myArray2 = Union(myTable.ListColumns(alpha(0)).DataBodyRange, _
            myTable.ListColumns(alpha(1)).DataBodyRange, _
            myTable.ListColumns(alpha(2)).DataBodyRange, _
            myTable.ListColumns(alpha(3)).DataBodyRange)
                                                       
End If


    Artikelsuche2.ListBox1.List = myArray2
    Artikelsuche2.ListBox1.ColumnHeads = True
    Artikelsuche2.Show
    Artikelsuche2.TextBox1.Text = Trim(ArtikelSuche.TextBox3.Text)
    

    Artikelsuche2.TextBox1.SetFocus
.
.
.
.


Well I thank you for your help
 

Attachments

  • if_checkboxes_after_eachother_it_works.png
    if_checkboxes_after_eachother_it_works.png
    83.8 KB · Views: 17

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
correction to text (since edit time over)

' here I am just testing and trying to figure out how to get the values done, like if only Checbox 8 is marked, but nothing else, it goes to Z = 1, but if 8 checkboxes are marked, then it goes to Z = 8 and do something. I will get rid of this also
' for now, lets see if 4 checkboyes are checked TRUE, so lets jump to Z = 4: ..........
 
Upvote 0
Using Listobject on sheet I have:
1 userform
1 Listbox
11 checkboxes
1 textbox

I tried to "comment" in the VBA code what i tryy to do.

My aim is to get a listbox show the columns of a listobject according to the checkboxes.
Here is a completely different approach which copies the main table's columns specified by the checkboxes to a 2nd table on another sheet (hidden if necessary). This 2nd table is linked to the ListBox by its RowSource property. Using the RowSource means the column headings are displayed in the ListBox and it can be scrolled up/down, left/right as required and keep the headings displayed. The code sets the column widths of the ListBox to the same as the column widths in the main table.

The workbook requires 2 sheets - Sheet1 and Sheet2. You should create the main table (ListObject) with 11 columns on Sheet1 with the required column headers and data rows. The name of the table doesn't matter because the code uses the first ListObject on Sheet1. Cells M2:M12 contain True or False for the initial values of the checkboxes on the user form (ticked or not ticked).

Userform controls - ListBox1; CheckBox1, CheckBox2, ... CheckBox11; CommandButton1 - click to update the ListBox1 after ticking/unticking the checkboxes.

VBA Code:
Option Explicit

Private Sub UserForm_Initialize()
   
    Dim mainTable As ListObject
    Dim i As Long, cell As Range
   
    'Set checkbox captions to same as the table headings and values (ticked/unticked) according to cells M2:M12 on Sheet1 (True or False values)
   
    Set mainTable = ThisWorkbook.Worksheets("Sheet1").ListObjects(1)
   
    i = 0
    For Each cell In Worksheets("Sheet1").Range("M2:M12")
        i = i + 1
        Me.Controls("Checkbox" & i).Caption = mainTable.ListColumns(i).Name
        Me.Controls("Checkbox" & i).Value = cell.Value
    Next
   
    Update_ListBox

End Sub


Private Sub CommandButton1_Click()
    Update_ListBox
End Sub


Private Sub Update_ListBox()

    Dim mainTable As ListObject
    Dim listBoxSheet As Worksheet
    Dim listBoxTable As ListObject
    Dim listBoxTableTopLeftCell As Range
    Dim listboxTableCols As Long, colWidths As String
    Dim i As Long
   
    Set mainTable = ThisWorkbook.Worksheets("Sheet1").ListObjects(1)
   
    Set listBoxSheet = ThisWorkbook.Worksheets("Sheet2")
   
    'Delete the ListBoxTable if it exists
   
    On Error Resume Next
    Set listBoxTable = listBoxSheet.ListObjects("ListBoxTable")
    On Error GoTo 0
    If Not listBoxTable Is Nothing Then listBoxTable.Delete
   
    'Loop through each Checkbox and, if true, copy the column for that CheckBox from the main table to Sheet2
   
    Set listBoxTableTopLeftCell = listBoxSheet.Range("A1")
    listboxTableCols = 0
    colWidths = ""
    For i = 1 To 11
        If Me.Controls("Checkbox" & i).Value Then
            mainTable.ListColumns(i).Range.Copy listBoxTableTopLeftCell.Offset(, listboxTableCols)
            colWidths = colWidths & mainTable.ListColumns(i).Range.Width & ","
            listboxTableCols = listboxTableCols + 1
        End If
    Next
   
    If listboxTableCols > 0 Then
   
        'Add a table named "ListBoxTable" on Sheet2 for displaying as the ListBox
       
        Set listBoxTable = listBoxSheet.ListObjects.Add(xlSrcRange, listBoxSheet.UsedRange, , xlYes)
        listBoxTable.Name = "ListBoxTable"
       
        'Assign the ListBoxTable to the ListBox
       
        With Me.ListBox1
            .RowSource = ""
            .ColumnCount = listboxTableCols
            .ColumnHeads = True
            .MultiSelect = fmMultiSelectSingle
            .TextAlign = fmTextAlignLeft
            .RowSource = "ListBoxTable"
            .ColumnWidths = Left(colWidths, Len(colWidths) - 1)
        End With
       
    Else
   
        'No columns to display on ListBox
       
        With Me.ListBox1
            .RowSource = ""
            .ColumnCount = 0
            .ColumnHeads = False
            .ColumnWidths = ""
        End With
       
    End If
   
End Sub
 
Last edited:
Upvote 0
Thank you very much, I will check it out.
Yes there are sure many other ways to achive my aim and in an elegant and easy way, but as I said, I am learning by doing, and I got to Listobjects.
On the userform u will also see a textbox. This textbox has a function: if you type in lets say "AL" "GR" and "NEW" it will search the Column "A" where all the columns from B:xy are bind together with trim, so it will search everything that has those letter in it, doesnt even matter in where those letter are (its like a fast search system. The code is here:

VBA Code:
Private Sub TextBox1_Change()

Dim results As Variant
Dim x, z
Dim i As Long, j As Long
Dim tx As String
Dim flag As Boolean
Dim lastrowsrc0 As Long

tx = Trim(UCase(Artikelsuche2.TextBox1.Text))

lastrowsrc0 = Sheets("ArtikelSuche_Temp").Range("i" & Rows.count).End(xlUp).Row

If tx <> oldValue Then
    With Artikelsuche2.ListBox1
        .Clear
        If tx <> "" Then
            .Clear
            
            For i = 1 To UBound(myarray, 1)
                
                flag = True
                For Each z In Split(tx, " ")
                    If InStr(1, myarray(i, 1), z, vbBinaryCompare) = 0 Then flag = False: Exit For
                Next
      
                If flag Then
                    .AddItem
'_________________________________________________________________ this fills up the listbox with new data according to textbox
'_________________________________________________________________

                    .List(j, 0) = myArray2(i, 1)
                    .List(j, 1) = myArray2(i, 2)
                    .List(j, 2) = myArray2(i, 3)
                    '.List(j, 3) = myArray2(i, 4)
                    '.List(j, 4) = myArray2(i, 5)
                    '.List(j, 5) = myArray2(i, 6)
                    
                    j = j + 1
                    If j = lastrowsrc0 Then Exit For 'limit number of items shown in listbox
                End If
    
           
            Next
        
            
        End If
    
    End With
End If
oldValue = tx



End Sub

(I got this from somewhere and I liked it).
But not yet there to fix it to my needs.

Regarding the array, I will check out if I can get it to work.

Many thanks anyways
 
Upvote 0
@Desantech
I think the code you mentioned in post #4 is my code. I can help you to amend the code to suit your needs.

1. Could you upload a sample workbook (without sensitive data) to a sharing site like dropbox.com or google drive? And then share the link here.
2. What do you meant by " where all the columns from B:xy are bind together"? Can you provide an example?
3. I don't quite understand how you want the checkboxes work? Say, you checked checkbox1 & checkbox4, do you want only col A & D shown in the listbox? So basically the listbox only show columns that are checked on the chekboxes?
 
Upvote 0
Hello, yes its the same papagay avatar :), then I stole it from you (sorry).
Well, I cant do any example workbook right now, but I send you later on. bind together like contategnate all the coloumns into 1 (quite slow), so I can search in that huge data with the textbox.
Yes if checkbox 1 and 9 are checked, then only 2 columns are shown in the listbox, according to the true/false values that are on a sheet, ergo M2 is for checkbox 1 (true/false), m3 is for checkbox3 and so on.
I just couldnt get it to work with this new world for me: "listobjects" / arrays.

But I think the soultion will be somewhere here:

VBA Code:
 Sub Westbury()
Dim Arr As Variant
With Worksheets("Data list").ListObjects("Data").Range
Arr = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,7,8}])
End With
'
'  Arr is an array containing all the rows of data from the referenced
'  table drawn from the 1st, 7th and 8th columns of that table
'
End Sub

according to Rick (I red in a thread here) where 1,7,8 is, I could replace those values with my alpha() array
I send you the file later on, and 100000X thanks
 
Upvote 0
ok got it to work thx to another thread here on mrexcel, happy

.
.

ElseIf z = 4 Then

ReDim alpha(0 To 11)

For i = 1 To 11
If a.Range("C" & i + 1).Value = True Then
alpha(x) = i + 1
x = x + 1
End If
Next i

Dim myarray2 As Variant

myarray2 = myTable.DataBodyRange.Value2
myarray2 = Application.Index(myarray2, Evaluate("ROW(1:" & UBound(myarray2) & ")"), Array(alpha(0), alpha(1), alpha(2), alpha(3)))

End If

UserForm1.ListBox1.ColumnHeads = True
UserForm1.ListBox1.List = myarray2

.
.
.
.
 
Upvote 0
Solution
Sorry for the late reply. I'm a bit busy this week.
But I'm glad you've found a solution.
 
Upvote 0

Forum statistics

Threads
1,215,040
Messages
6,122,806
Members
449,095
Latest member
m_smith_solihull

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