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
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 : ⬇
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






No comments:
Post a Comment