Set it in code as you did or set at design in the columnwidths property for the listbox1 control.
Printable View
Set it in code as you did or set at design in the columnwidths property for the listbox1 control.
one more question:
How do you control how many rows get copied to the combined sheet (sheet5)? Currently, it won't copy more 6 rows?
In Sub FillSheet5(), replace the line towards the end after the comment.
Code:'ListBox1.List = a 'Unsorted totally
Set r = Sheet5.Range("A2").Resize(UBound(a, 1), UBound(a, 2))
Perfect, Thank you!
Nimesh-
Hi Kenneth,
Hate to bother you with this again but, I just done setting up my user form and ran into issue after I RUN the filter, when selecting a line in the listbox. When I go to debug it takes me to code below, line [s = ListBox1.List(ListBox1.ListIndex, 16)]. Everything looks okay???
I have 16 controls in the userform.
Code:Private Sub ListBox1_Click()
Dim i As Integer, A, s As String
For i = 1 To 16
Controls("Reg" & i) = ListBox1.Column(i - 1)
Next i
s = ListBox1.List(ListBox1.ListIndex, 16)
s = Split(s, "]")(1)
s = Split(s, "'")(0)
ComboBox1.Value = s
End Sub
Did you set the Listbox1.ColumnCount proeprty to 16 or more?
It's set to '0', I am using code to control column count in the listbox.
Error only occurs when I filter the list and try selecting something, otherwise, I am able to select and controls get filled.
I increased the column count where I needed to, per your sample.
Error: "Could not get the List Property. Invalid argument."
Code:Option Explicit
Private Sub ListBox1_Click()
Dim i As Integer, A, s As String
For i = 1 To 16
Controls("Reg" & i) = ListBox1.Column(i - 1)
Next i
s = ListBox1.List(ListBox1.ListIndex, 16)
s = Split(s, "]")(1)
s = Split(s, "'")(0)
ComboBox1.Value = s
End Sub
'Previous, http://www.vbaexpress.com/forum/showthread.php?60743-Populate-ListBox-from-Multiple-sheets
'http://www.vbbaexpress.com/forum/showthread.php?60840-Userform-Listbox-Filter-using-comboBox&p=370212
Private Sub UserForm_Initialize()
Dim WS As Worksheet
'To have more then 10 columns in ListBox
ListBox1.Clear
ListBox1.List = Range("A3:Q100").Value
ListBox1.ColumnCount = UBound(ListBox1.List, 2) + 1
ListBox1.ColumnWidths = "45;30;45;65;120;45;45;70;45;25;25;45;45;45;65;40" 'COLUMN WITDH OF LISTBOX. Column 17 is not pulled into control
'loop through worksheets to fill combobox1
ComboBox1.Clear
For Each WS In Worksheets
'use the code name in case sheet name changes
Select Case WS.CodeName
'exclude these sheets by code name
Case "Sheet1", "Sheet2", "Sheet5", "Sheet6"
'Add the rest
Case Else
ComboBox1.AddItem WS.Name
End Select
Next WS
FillSheet5
'<<<<--------------------------Code Below to change Userform Graphic------------------->>>>
'change All Combobox and Textbox colors
Dim ctrl As Control
For Each ctrl In UserForm1.Controls
With ctrl
Select Case UCase(TypeName(ctrl))
Case "TEXTBOX", "COMBOBOX"
.BackColor = RGB(75, 116, 71)
Case "LABEL"
.BackColor = RGB(134, 172, 65) ' Green -New grass
.ForeColor = RGB(255, 255, 255)
With .font
.Name = "calibri"
'.FontStyle = "Bold Italic" 'No, errors
.Bold = False
.Italic = False
.Size = 10
End With
Case Else
End Select
End With
Next ctrl
End Sub
'<<<<-------------------------End of Graphics Code------------------------------------->>>>
Private Sub UserForm_Terminate()
'ClearAFs
End Sub
Private Sub FillSheet5()
Dim WS As Worksheet, r As Range
Dim LastRow As Long, A, b, i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With Sheet5
Intersect(.UsedRange, .Range(.Rows(2), .Rows(.Rows.Count))).Clear
End With
'loop through worksheets
For Each WS In Worksheets
'use the code name in case sheet name changes
Select Case WS.CodeName
'exclude these sheets by code name
Case "Sheet1", "Sheet2", "Sheet5", "Sheet6"
'Add the rest
Case Else
With WS
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set r = .Range("A2:Q" & LastRow).SpecialCells(xlCellTypeVisible)
WSsort r 'sort to move blank rows to end
'Reset range to skip blank rows moved to end
Set r = .Range("A2:Q" & LastRow).SpecialCells(xlCellTypeVisible)
If Not IsArray(A) Then
A = r
'Add full address to column 17 in array
For i = 1 To UBound(A, 1)
A(i, 17) = r(i, "A").Address(external:=True)
Next i
'Debug.Print LBound(a, 1), LBound(a, 2); UBound(a, 1), UBound(a, 2)
Else 'Add full address to column 17 in array
b = r
For i = 1 To UBound(b, 1)
b(i, 17) = r(i, "A").Address(external:=True)
Next i
'www.cpearson.com/excel/VBAArrays.htm
A = CombineTwoDArrays(A, b)
End If
End With
End Select
Next WS
'a = BubbleSort(a, 1) 'sort 2d array, not good
'Better sort...
'ListBox1.List = a 'Unsorted totally
Set r = Sheet5.Range("A2").Resize(UBound(A, 1), UBound(A, 2))
r.Value = A
WSsort r
'Set r = Sheet5.Range("A2").Resize(2 + UBound(a, 2), 5)
ListBox1.List = r.Value
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
'<<<<--------------------------All Command Button Codes------------------->>>>
'Update
Private Sub CommandButton3_Click()
Dim r As Range, aRow As Long, i As Integer, s As String
Dim WS As Worksheet
s = ListBox1.List(ListBox1.ListIndex, 16)
s = Split(s, "]")(1)
Set WS = Worksheets(Split(s, "'")(0))
aRow = Range(Split(s, "!")(1)).Row
Debug.Print aRow
With WS
For i = 1 To 16
.Cells(aRow, i) = Controls("Reg" & i)
Next i
.Activate
.Range("A" & aRow & ":P" & aRow).Select
End With
UserForm_Initialize
End Sub
'Filter button
Private Sub CommandButton4_Click()
Dim WS As Worksheet, r As Range
Dim LastRow As Long, A, b, i As Long
Dim od As New DataObject, s As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With Sheet5
.UsedRange.AutoFilter 8, ComboBox2.Value
.UsedRange.AutoFilter 11, ComboBox3.Value
'If .UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then _
GoTo TheEnd
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set r = .Range("A2:q" & LastRow).SpecialCells(xlCellTypeVisible)
If r Is Nothing Then GoTo TheEnd
End With
r.Copy
od.GetFromClipboard
Application.CutCopyMode = False
ListBox1.Clear
s = od.GetText
ListBox1.List = StringTo2dArray(s)
TheEnd:
Set od = Nothing
If Sheet5.AutoFilterMode Then Sheet5.UsedRange.AutoFilter
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'Enter count of the filtered list
Label27.Caption = ListBox1.ListCount
UserForm1.Label27.BackColor = RGB(249, 220, 36) 'Yellow
End Sub
Private Sub ClearAFs()
Dim WS As Worksheet
For Each WS In Worksheets
Select Case WS.CodeName
Case "Sheet1", "Sheet2", "Sheet5", "Sheet6"
Case Else
If WS.AutoFilterMode Then WS.UsedRange.AutoFilter
End Select
Next WS
End Sub
'To Send to selected sheet
Private Sub CommandButton1_Click()
Dim cNum As Integer
Dim x As Integer
Dim nextrow As Range
Dim sht As String
'set the variable for the sheet
sht = ComboBox1.Value
'check for values
If Me.ComboBox1.Value = "" Then
MsgBox "Select a sheet from the combobox and add the date"
Exit Sub
End If
'change the number for the number of controls on the userform
cNum = 16
'add the data to the selected worksheet
Set nextrow = Sheets(sht).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For x = 1 To cNum
nextrow = Me.Controls("Reg" & x).Value
Set nextrow = nextrow.Offset(0, 1)
Next x
'clear the values in the userform
For x = 1 To cNum
Me.Controls("Reg" & x).Value = ""
Next x
'Clear Combobox1
ComboBox1.Clear
'communicate the results
MsgBox "The values have been sent to the " & sht & " sheet"
End Sub
'close the userform
Private Sub commandbutton2_Click()
Unload Me
End Sub
'CLEAR BUTTON
Private Sub CommandButton5_Click()
Dim oneControl As Object
For Each oneControl In UserForm1.Controls
Select Case TypeName(oneControl)
Case "TextBox"
oneControl.Text = vbNullString
'Case "CheckBox"
' oneControl.Value = False
Case "ComboBox" 'Code below includes comboxes you want to clear
If InStr(1, "ComboBox1 comboBox2 comboBox3 Reg8 Reg9 Reg10 Reg11 Reg12 Reg13 Reg14 Reg16", oneControl.Name & " ") <> 0 Then
oneControl.Text = vbNullString
End If
End Select
Next oneControl
'Refresh the Listbox
UserForm_Initialize
End Sub
'Clear Search Textbox Button
Private Sub CommandButton6_Click()
ComboBox2.Value = "": ComboBox3.Value = ""
Label27.Caption = ""
'Refresh the Listbox
UserForm_Initialize
End Sub
'To make the Excel sheet Visible
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = False Then
Application.Visible = False
End If
If ToggleButton1.Value = True Then
Application.Visible = True
End If
End Sub
Private Sub CommandButton8_Click()
Dim sat As Long, sut As Byte, s2 As Worksheet, bu As Long
If ListBox1.ListCount = 0 Then
MsgBox "No Data to Copy!", vbExclamation
Exit Sub
End If
Set s2 = Sheets("FilterData")
sat = ListBox1.ListCount
sut = ListBox1.ColumnCount
bu = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
s2.Range("A" & bu & ":P" & sat + bu - 1) = ListBox1.List
MsgBox "Data Copied."
End Sub
'Button to save the file from userfrom
Private Sub CommandButton9_Click()
ThisWorkbook.Save
End Sub
Private Sub CommandButton10_Click() 'Close this Workbook
ThisWorkbook.Close
End Sub
'<<<<--------------------------End of Command button Codes------------------->>>>
'<<<<--------------------------Spin button Code------------------->>>>
'Spin Button for Listbox scrolling
Private Sub SpinButton1_SpinDown()
On Error Resume Next
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
With Me.ListBox1
.ListIndex = .ListIndex + 1
End With
End Sub
Private Sub SpinButton1_SpinUp()
On Error Resume Next
If ListBox1.ListIndex = 0 Then Exit Sub
With Me.ListBox1
.ListIndex = .ListIndex - 1
End With
End Sub
'<<<<--------------------------End Spin Button Code------------------->>>>
'<<<<------------------To Call Code--------------->>>>
Private Sub csipop_Click() 'load CSI Userform
CSIUserform.Show
End Sub
I guess you understand that List's 16 is the 17th column item? It looks like your "17th" column value is the External Address. So, your column count must be at least 17.
Code:b(i, 17) = r(i, "A").Address(external:=True)
Listbox is showing 17 columns but I am only using columns 16 to fill 16 controls. At the end, I will not show the External address in the listbox.
I was able to get it to work on sample file using the same information so, I am just stumped right now.
What is the problem with this one?