Kapat

How To Add More Than 10 Columns To Excel ListBox?

excel address list

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 ;

excel 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 : excel address list

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.

excel address list
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) vba change data on userform 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.

excel 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: excel id  numbers

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

excel userform listbox additem 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 : 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
vba listbox column phone format 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.

excel address book

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. excel option button

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.

excel vba move image 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) : vba moving image

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

You can download 📥 sample workbook here