Function ControlsResizeColumns(LBox As MSForms.Control, Optional ResizeListbox As Boolean)
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim i As Integer
If sheetExists("ListboxColumnWidth", ThisWorkbook) = False Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = "ListboxColumnwidth"
Else
Set ws = ThisWorkbook.Worksheets("ListboxColumnwidth")
ws.Cells.Clear
End If
'---Listbox/Combobox to range-----
Dim rng As Range
Set rng = ThisWorkbook.Sheets("ListboxColumnwidth").Range("A1")
Set rng = rng.Resize(UBound(LBox.List) + 1, LBox.ColumnCount)
rng = LBox.List
rng.Characters.Font.Name = Artikelsuche2.ListBox1.Font.Name
rng.Characters.Font.Size = Artikelsuche2.ListBox1.Font.Size
rng.Columns.AutoFit
'---Get ColumnWidths------
rng.Columns.AutoFit
Dim sWidth As String
Dim vR() As Variant
Dim n As Integer
Dim cell As Range
For Each cell In rng.Resize(1)
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = cell.EntireColumn.Width + 20 'if not some extra space it cuts a bit off the tail
Next cell
sWidth = Join(vR, ";")
Debug.Print sWidth
'---assign ColumnWidths----
With LBox
.ColumnWidths = sWidth
'.RowSource = "A1:A3"
.BorderStyle = fmBorderStyleSingle
End With
'----Optionaly Resize Listbox/Combobox--------
If ResizeListbox = True Then
Dim w As Long
For i = LBound(vR) To UBound(vR)
w = w + vR(i)
Next
DoEvents
LBox.Width = w + 10
End If
'remove worksheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function
Function sheetExists(sheetToFind As String, Optional InWorkbook As Workbook) As Boolean
If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook
On Error Resume Next
sheetExists = Not InWorkbook.Sheets(sheetToFind) Is Nothing
End Function
Private Sub UserForm_Initialize()
Dim z As Integer
Dim alpha() As Variant
Dim beta() As Variant
Dim x As Long
Dim y As Long
Dim i As Integer
Dim a As Variant
Dim myarray3() 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
Artikelsuche2.ListBox2.ColumnCount = z
'' I set a static pt width of each column (?)
' Artikelsuche2.ListBox1.ColumnWidths = "100"
' Artikelsuche2.ListBox2.ColumnWidths = "100"
' I give a name "myTable" to the Listobject found on sheet "Artikelsuche_Temp" called "myTable_Source") I guess needed for textbox script
Set myTable = Worksheets("ArtikelSuche_Temp").ListObjects("myTable_Source")
myArray = myTable.DataBodyRange
ReDim beta(0 To 11)
ReDim alpha(0 To 11)
For i = 1 To 11
If a.Range("M" & i + 1).Value = True Then
alpha(x) = i + 1
beta(y) = i + 1
x = x + 1
y = y + 1
End If
Next i
myarray2 = myTable.DataBodyRange.Value2
myarray2 = Application.Index(myarray2, Evaluate("ROW(1:" & UBound(myarray2) & ")"), Array(alpha(0), alpha(1), alpha(2), alpha(3), alpha(4), alpha(5), alpha(6), alpha(7), alpha(8), alpha(9), alpha(10), alpha(11)))
myarray3 = myTable.HeaderRowRange.Value2
myarray3 = Application.Index(myarray3, Evaluate("ROW(1:" & 5 & ")"), Array(beta(0), beta(1), beta(2), beta(3), beta(4), beta(5), beta(6), beta(7), beta(8), beta(9), beta(10), beta(11)))
Artikelsuche2.ListBox1.List = myarray2
Artikelsuche2.ListBox2.List = myarray3
'------------------------------------With rowsource (experiment)
'Artikelsuche2.ListBox1.ColumnHeads = True
Dim intStartRow As Integer, intStartCol As Integer
Dim oWorksheet As Worksheet
Dim rngCopyTo As Range
Dim rowsource_temp As Range
Dim rowsource_temp1 As String
Set oWorksheet = ActiveWorkbook.Worksheets("AS_T1")
Dim intEndRow As Integer
Dim intEndCol As Integer
intEndRow = UBound(myarray2, 1)
intEndCol = z
Set rngCopyTo = oWorksheet.Range(oWorksheet.Cells(1, 1), oWorksheet.Cells(intEndRow, intEndCol))
rngCopyTo.Value = myarray2
rowsource_temp1 = rngCopyTo.Offset(1, 0).Address
'ListBox1.RowSource = Sheets("AS_T1").Name & "!" & Range(rowsource_temp1).Address
'---------------------------------------------------- end row source (not affecting the listboxes)
Artikelsuche2.TextBox1.Text = Trim(ArtikelSuche.TextBox3.Text)
Artikelsuche2.TextBox1.SetFocus
Call ControlsResizeColumns(Artikelsuche2.ListBox1)
'Dim e
'Dim g
'Dim cnt1 As Integer
'cnt1 = 0
'For Each e In Split(Artikelsuche2.ListBox1.ColumnWidths, ";")
'cnt1 = cnt1 + 1
'With Artikelsuche2
'g = Left(Right(e, Len(e)), Len(e) - 3)
'.Controls("Label" & cnt1).Width = Left(Right(e, Len(e)), Len(e) - 3)
'End With
' Debug.Print g
' Next e
End Sub