Populate single listbox merging different ranges from different sheets

Hi all,
I need to populate in a userform a single multicolumn listbox merging different ranges from different sheets.

This is the code:

Code:

---


Private Sub UserForm_Initialize()
Dim LastRow As Long
LastRow = Sheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Row + 1
Data = Sheets("Sheet1").Range("A4:I" & LastRow)
With ListBoxPazienti
.ColumnCount = 9
.ColumnWidths = "100"
.List = Data
.ListIndex = -1
End With
End Sub

---

I would populate this listbox with data of multiple sheets named "Sheet1", "Sheet2", "Sheet3", etc.

All sheets have the same number and name of the columns.

Is it possible? Is there a vba code?

Thanks in advance.

Kind regards,
Fabrizio

Greetings and welcome to VBAX :hi:,

I am awfully rusty (a year away!), but this appears to work:

Code:

---

Private Sub UserForm_Initialize()
Dim LastRow            As Long
Dim N                  As Long
Dim lCol                As Long
Dim lRow                As Long
Dim RowInColOne        As Long
Dim ColumnInCurrentRow  As Long
Dim MyArray            As Variant
Dim MyData              As Variant
Dim bHasData            As Boolean
 
  With ListBoxPazienti
    .ColumnCount = 9
    .ColumnWidths = "100"
  End With
 
  MyArray = Array("Sheet1", "Sheet2", "Sheet3")
 
  For N = LBound(MyArray) To UBound(MyArray)
    If ShExists(MyArray(N), ThisWorkbook) Then
      LastRow = ThisWorkbook.Worksheets(MyArray(N)).Cells(ThisWorkbook.Worksheets(MyArray(N)).Rows.Count, "I").End(xlUp).Row + 1
      MyData = ThisWorkbook.Worksheets(MyArray(N)).Range("A4:I" & LastRow).Value
      For RowInColOne = 1 To UBound(MyData)
        ListBoxPazienti.AddItem MyData(RowInColOne, 1)
        For ColumnInCurrentRow = 2 To UBound(MyData, 2)
          ListBoxPazienti.List(ListBoxPazienti.ListCount - 1, ColumnInCurrentRow - 1) = MyData(RowInColOne, ColumnInCurrentRow)
        Next
      Next
      bHasData = True
    End If
  Next N
 
  If bHasData Then ListBoxPazienti.ListIndex = -1
 
End Sub

---

Hope that helps,

Mark

PS. - Not sure why you are adding a row to LastRow, as this would seem to grab a blank row? I'll try and check back tomorrow.

Welcome to the forum!

CombineTwodArrays(): See http://www.cpearson.com/excel/VBAArrays.htm

Quote:

---

Originally Posted by GTO

Greetings and welcome to VBAX :hi:,

I am awfully rusty (a year away!), but this appears to work:

Code:

---

Private Sub UserForm_Initialize()
Dim LastRow            As Long
Dim N                  As Long
Dim lCol                As Long
Dim lRow                As Long
Dim RowInColOne        As Long
Dim ColumnInCurrentRow  As Long
Dim MyArray            As Variant
Dim MyData              As Variant
Dim bHasData            As Boolean
 
  With ListBoxPazienti
    .ColumnCount = 9
    .ColumnWidths = "100"
  End With
 
  MyArray = Array("Sheet1", "Sheet2", "Sheet3")
 
  For N = LBound(MyArray) To UBound(MyArray)
    If ShExists(MyArray(N), ThisWorkbook) Then
      LastRow = ThisWorkbook.Worksheets(MyArray(N)).Cells(ThisWorkbook.Worksheets(MyArray(N)).Rows.Count, "I").End(xlUp).Row + 1
      MyData = ThisWorkbook.Worksheets(MyArray(N)).Range("A4:I" & LastRow).Value
      For RowInColOne = 1 To UBound(MyData)
        ListBoxPazienti.AddItem MyData(RowInColOne, 1)
        For ColumnInCurrentRow = 2 To UBound(MyData, 2)
          ListBoxPazienti.List(ListBoxPazienti.ListCount - 1, ColumnInCurrentRow - 1) = MyData(RowInColOne, ColumnInCurrentRow)
        Next
      Next
      bHasData = True
    End If
  Next N
 
  If bHasData Then ListBoxPazienti.ListIndex = -1
 
End Sub

---

Hope that helps,

Mark

PS. - Not sure why you are adding a row to LastRow, as this would seem to grab a blank row? I'll try and check back tomorrow.

---

Thanks a lot for your help. I added a blank row at the end only to check the beginning of the new sheet during my test.

I will try your code as soon as possible.
Let you know asap.

Thanks again

Dear GTO the code is perfect, I have only one problem with If ShExists(MyArray(N), ThisWorkbook) Then but I removed this line.
Now I am trying to filter the listbox by 3 textboxes.
I hope well. :think:

Thanks
Fabrizio

Hi GTO, hi all,
I have many problem to filter the listbox when one ore more textboxes change.

With one textbox (surname) I do not have any problems. But I'm not able to add other filters in the same time and for all sheet.

For your interest, after I will fix the filter by textboxes, I would to be able to:

- add new records
- update records
- delete records

This is the code on textbox changes

Code:

---

Public LastRow As Long
Private Sub FilterList(iCtrl As Long, sText As String)
Dim iRow As Long
Dim sCrit As String
sCrit = "*" & UCase(sText) & "*"
With Me.ListBoxPazienti

LastRow = Range("I65536").End(xlUp).Row
.List = Range("A4:I" & LastRow).Value

For iRow = .ListCount - 1 To 0 Step -1
If Not UCase(.List(iRow, iCtrl)) Like sCrit Then
.RemoveItem iRow
End If
Next iRow
End With
End Sub

Private Sub txtCercaSurname_Change()
  FilterList 0, Me.txtCercaSurname.Text
End Sub

Private Sub txtCercaName_Change()
  FilterList 0, Me.txtCercaSurname.Text
  FilterList 1, Me.txtCercaName.Text
End Sub

---

This is my file test
Attachment 23538

Could you help me?

Thanks in advance,
Fabrizio

Quote:

---

Originally Posted by pootheyes

Dear GTO the code is perfect, I have only one problem with If ShExists(MyArray(N), ThisWorkbook) Then but I removed this line.
Now I am trying to filter the listbox by 3 textboxes.
I hope well. :think:

Thanks
Fabrizio

---

Hi Fabrizio,

Apologies, I forgot to include the Function, which would go in a Standard Module

Code:

---

Function ShExists(ShName As String, _
                  Optional wb As Workbook, _
                  Optional CheckCase As Boolean = False) As Boolean
   
    If wb Is Nothing Then
        Set wb = ThisWorkbook
    End If
   
    If CheckCase Then
        On Error Resume Next
        ShExists = CBool(wb.Worksheets(ShName).Name = ShName)
        On Error GoTo 0
    Else
        On Error Resume Next
        ShExists = CBool(UCase(wb.Worksheets(ShName).Name) = UCase(ShName))
        On Error GoTo 0
    End If
End Function

---

:

This way we check to make sure the sheet exists before working with it.

Mark

Quote:

---

Originally Posted by GTO

Hi Fabrizio,

Apologies, I forgot to include the Function, which would go in a Standard Module

Code:

---

Function ShExists(ShName As String, _
                  Optional wb As Workbook, _
                  Optional CheckCase As Boolean = False) As Boolean
   
    If wb Is Nothing Then
        Set wb = ThisWorkbook
    End If
   
    If CheckCase Then
        On Error Resume Next
        ShExists = CBool(wb.Worksheets(ShName).Name = ShName)
        On Error GoTo 0
    Else
        On Error Resume Next
        ShExists = CBool(UCase(wb.Worksheets(ShName).Name) = UCase(ShName))
        On Error GoTo 0
    End If
End Function

---

:

This way we check to make sure the sheet exists before working with it.

Mark

---

Thanks