How To Add More Than 10 Columns To Excel ListBox ?

Excel VBA Add More Columns To ListBox


Before we get into how to add more than 10 columns to Excel listbox, let’s talk about the other properties of the address list userform. In the advanced address book we created ;

  A new record can be added using text boxes. While recording, if name and phone information is missing, a warning is given by msgbox. The numerical value is checked for TextBox3 where the phone number is located. Likewise, the numerical value is checked for textboxes with other phone numbers using VBA codes :
If TextBox1.Text = "" Or TextBox3.Text = "" Then
MsgBox "Incomplete Data", vbCritical, ""
TextBox1.SetFocus
Exit Sub
End If
If IsNumeric(TextBox3) = False Then
MsgBox "False or incomplete info", vbCritical, ""
TextBox3.SetFocus
Exit Sub
End If
If TextBox4 <> Empty And IsNumeric(TextBox4) = False Then
MsgBox "False or incomplete info", vbCritical, ""
TextBox4.SetFocus
Exit Sub
End If
If TextBox5 <> Empty And IsNumeric(TextBox5) = False Then
MsgBox "False or incomplete info", vbCritical, ""
TextBox5.SetFocus
Exit Sub
End If 
If this record has been saved before, VBA codes will give a warning. VBA codes on userform to avoid the duplicate data record : 
Dim ara as Range
lastrow = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row
Set ara = Range("B2:B" & lastrow).Find(What:=TextBox1.Text,LookIn:=xlValues,LookAt:=xlWhole)
        If Not ara Is Nothing Then
        MsgBox "This name already exist ! Please try a different name", vbCritical, ""
        TextBox1.SetFocus
        Exit Sub
        End If
   The record can be changed. When changes are made to the record, the record is updated automatically in the worksheet and on the listbox.


If TextBox1.Text = "" Or TextBox3.Text = "" Then
MsgBox "Item Is Not Selected To Change", vbCritical, ""
Exit Sub
End If

sor = MsgBox("Are your sure?", vbYesNo, "")
If sor = vbNo Then Exit Sub
lastrow = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("liste").Range("B2:B" & lastrow).Find(What:=ListBox1.Text, -
   LookIn:=xlValues, LookAt:=xlWhole).Activate
sonsat = ActiveCell.Row

Cells(sonsat, 2) = TextBox1
Cells(sonsat, 3) = TextBox2
Cells(sonsat, 4) = TextBox3
Cells(sonsat, 5) = TextBox4
Cells(sonsat, 6) = TextBox5
Cells(sonsat, 7) = TextBox6
Cells(sonsat, 8) = TextBox7
Cells(sonsat, 9) = TextBox8
Cells(sonsat, 10) = TextBox11
Cells(sonsat, 11) = TextBox12
Cells(sonsat, 12) = TextBox13
Cells(sonsat, 13) = TextBox14

Range("A" & sonsat & ":M" & sonsat).Font.ColorIndex = 11
MsgBox "Item Has Been Changed", vbInformation, ""
ListBox1.Value = Sheets("liste").Cells(sonsat, 2)
ListBox1.Value = Sheets("liste").Cells(sonsat, 2)  → With these VBA codes, the listbox item that has been changed is selected in the listbox that is refilled after the change is made in the record. This way, we can see which record of the address list we changed and the change we made.

  The desired record can be deleted by using the Delete button on the userform.

  In column A, the sequential numbers are assigned for each record . When any record is deleted or added, the sequence numbers are automatically rearranged with the help of the procedure. Our VBA codes we use for this purpose : 
Sub sort_id() Dim k As Long
On Error Resume Next
For k = 2 To Cells(Rows.Count, "A").End(xlUp).Row
   Cells(k, 1).Value = k - 1
Next k
End Sub 
  The records are listed on the listbox, the details of the item selected from the listbox are displayed in the text boxes. We used a do-while loop to add row more than 10 columns to listbox
sat = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row

ReDim arrs(1 To 12, 1 To 1)
ListBox1.Clear
ListBox1.ColumnCount = 12
    k = 1
        Do
            m = m + 1        
 k = k + 1
            ReDim Preserve arrs(1 To 12, 1 To m)
            For j = 1 To 12
                arrs(j, m) = Sheets("liste").Cells(k, j + 1).Value
                If j = 3 Or j = 4 Or j = 5 Then
                arrs(j, m) = Format(Sheets("liste").Cells(k, j + 1).Value, "(###) ###-####")
                End If
            Next j
          
        Loop While Not k = sat
ListBox1.Column = arrs
If j = 3 Or j = 4 Or j = 5 Then
arrs(j, m) = Format(Sheets("liste").Cells(k, j + 1).Value, "(###) ###-####")
End If      →  We used these VBA codes to convert to phone format the 3rd, 4th, 5th columns of listbox

✓  User can search for the names of the records in the worksheet, The results found are listed in the listbox. 

To search for data in the worksheet and sort the results in the listbox, we must populate the listbox using the AddItem method. A maximum of 10 columns can be added to the listbox with the VBA AddItem method.

We can use array variables to overcome this problem. We used arrays to search in the listbox using the textbox and to list the search results found in the listbox : 
ReDim arrs(1 To 12, 1 To 1)
With Worksheets("liste")
ListBox1.Clear
ListBox1.ColumnCount = 12
    
  If .FilterMode Then .ShowAllData
   If OptionButton1.Value = True Then
   Set k = .Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Find(What:=TextBox9.Text & "*", -
        LookIn:=xlValues, LookAt:=xlWhole)
    Else
   Set k = .Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Find(What:="*" & TextBox9.Text & "*", -
        LookIn:=xlValues, LookAt:=xlWhole)
   End If
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            m = m + 1
            ReDim Preserve arrs(1 To 12, 1 To m)
            For j = 1 To 12
                arrs(j, m) = .Cells(k.Row, j + 1).Value
            Next j
    Set k = .Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = arrs
   End If
End With 
As seen in the above VBA codes , we are looking for the entered value to Textbox9 in column B. Because in the address book, the names are in the B column. Two types of searches can be made at the beginning or across the cell value.We provide this with the option buttons.

✓  The row corresponding to the item selected from the listbox is also automatically selected in the worksheet. We provide the selection process with the following codes : 
Dim say, lastrow As Long
lastrow = Sheets("liste").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("liste").Range("B2:B" & lastrow).Find(What:=ListBox1.Value, LookIn:=xlValues, -
   LookAt:=xlWhole).Activate
say = ActiveCell.Row
Sheets("liste").Range("A" & say & ":M" & say).Select 
Sheets (“list”). Cells (Rows.Count, “B”). End (xlUp). Row  → This codes give us the row number of the last filled cell in column B.

✓  We created small animations by moving the images on the userform up and down, left and right. Image actions are triggered when the listbox is filled and any of the listbox items are selected.

VBA codes to move image on userform (left-right) : 
Sub Sag_sol()
Dim i, j As Integer
Application.ScreenUpdating = False
With UserForm2.Image3
  .Visible = True
    For i = 1 To 2000
  .Left = 324
    DoEvents
Next i

    For i = 1 To 2000
  .Left = 296
    DoEvents
Next i

End With
Application.ScreenUpdating = True
End Sub 
✓  When a new record is added to the page without using the userform, if that record already exists in column B, VBA codes will warn you with a message box.
To achieve this, we added the following codes to the Worksheet_Change procedure : 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim son As Long, onay, bul As String
Dim ara As Range
    
 If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
   son = Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next
  If WorksheetFunction.CountIf(Range("B2:B" & son), Target) < 1 Then
  Exit Sub
  End If
   If WorksheetFunction.CountIf(Range("B2:B" & son), Target) > 1 Then
    bul = Empty
      Set ara = Range("B2:B" & son).Find(Target, , xlValues, xlWhole)
      If Not ara Is Nothing Then
         adres = ara.Address
            Do
          bul = bul & ara.Row & "      -      " & Cells(ara.Row, "B") & Chr(10)
       Set ara = Range("B2:B" & son).FindNext(ara)
            Loop While Not ara Is Nothing And ara.Address <> adres
       End If
       MsgBox "This record already exists." & vbLf & "" & vbLf & "Row :  -
           Records :" & vbCrLf & Chr(10) & bul & vbLf & " ", vbCritical, ""
          
 Target.ClearContents
 Target.Activate
      End If
End Sub 
excel vba game

No comments:

Post a Comment