Problem with populate listbox using Application.Index

[purinqui]

Hi everybody.
I have a problem with a population of a listbox using the method Application.index.

I need load a listbox with a series of data in a sheet.

I only need just some data (some rows) of the sheet. This data is filtered by a intelligent search that indicate which row should be load in the listbox.

My problem is:

I dont know how can i do, to manage the variable rows to be implemented with the Method Application.index.

What i could achieve so far is:

i can populate the listbox, but integrating the whole sheet:

Private Sub datesearch_Change()

Worksheets("register").Activate
sizerow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Worksheets("register").AutoFilterMode = False
historial.ColumnHeads = False


Dim x, Arr As Variant


   Arr = Application.Index(Cells, Evaluate("ROW(1:" & Cells(Rows.Count, "A").End(xlUp).Row & ")"), Application.Transpose([row(1:15)])) 'Generating Array
 
  'Format of column date of the Array
  For x = 1 To UBound(Arr)
    Arr(x, 1) = Format(Arr(x, 1), "d/m/yyyy")
  Next
  
historial.List = Arr ' Populate Listbox


'Intelligent Search
i = 1
For rowin = 2 To sizerow

    dateinput = Worksheets("register").Cells(rowin, 1).Value

            If dateinput Like "*" & Me.datesearch.Value & "*" Or rowin = 1 Then


'''''''''''''''''Do something in order to only load the rows that match the search on the Listbox "historial"

            End If

Next


End Sub


Private Sub UserForm_Initialize()

'Definition of Listbox "historial"
With Me.historial

    .ColumnCount = 15
    .ColumnHeads = True
    
End With


End Sub

when i run the code, i get this:





But in this case the listbox is populated with all the data of the sheet, and i need only load some specifically rows, that i don't know which will be.

In my ignorancy, i need something like this¨:

Arr = Application.Index(Cells, Array(..................), Application.Transpose([row(1:15)]))
where on the dotted line, would go the rows that are determined by the intelligent search.

I would appreciate any help .

the file I'm working on:

Aplication.index

Folder

1drv.ms

 

[DanteAmor]

I dont know how can i do, to manage the variable rows to be implemented with the Method Application.index.

Could be like this:

Private Sub CommandButton1_Click()
  Dim sh As Worksheet
  Dim a As Variant, b() As Variant, arr As Variant
  Dim i As Long, j As Long
  
  If datesearch = "" Or Not IsDate(datesearch) Then
    MsgBox "Enter a date"
    datesearch.SetFocus
    Exit Sub
  End If
  
  Set sh = Sheets("register")
  a = sh.Range("A1", sh.Range("A" & Rows.Count).End(3)).Value
  
  For i = 1 To UBound(a)
    If a(i, 1) = CDate(datesearch) Then
      ReDim Preserve b(j)
      b(j) = i
      j = j + 1
    End If
  Next
  arr = Application.Index(Cells, Application.Transpose(b), Application.Transpose([row(1:15)]))
  For i = 1 To UBound(arr)
    arr(i, 1) = Format(arr(i, 1), "d/m/yyyy")
  Next
  historial.List = arr
End Sub

Or without using index:

Private Sub CommandButton2_Click()
  Dim sh As Worksheet
  Dim a As Variant, b() As Variant
  Dim i As Long, j As Long, k As Long, n As Long
  
  If datesearch = "" Or Not IsDate(datesearch) Then
    MsgBox "Enter a date"
    datesearch.SetFocus
    Exit Sub
  End If
  
  Set sh = Sheets("register")
  a = sh.Range("A1:O" & sh.Range("A" & Rows.Count).End(3).Row).Value
  n = WorksheetFunction.CountIf(sh.Range("A:A"), CDate(datesearch))
  ReDim b(1 To n, 1 To 15)
  For i = 1 To UBound(a)
    If a(i, 1) = CDate(datesearch) Then
      k = k + 1
      b(k, 1) = Format(a(i, 1), "d/m/yyyy")
      For j = 2 To 15
        b(k, j) = a(i, j)
      Next j
    End If
  Next i
  historial.List = b
End Sub

 

[purinqui]

Could be like this:

Private Sub CommandButton1_Click()
  Dim sh As Worksheet
  Dim a As Variant, b() As Variant, arr As Variant
  Dim i As Long, j As Long
 
  If datesearch = "" Or Not IsDate(datesearch) Then
    MsgBox "Enter a date"
    datesearch.SetFocus
    Exit Sub
  End If
 
  Set sh = Sheets("register")
  a = sh.Range("A1", sh.Range("A" & Rows.Count).End(3)).Value
 
  For i = 1 To UBound(a)
    If a(i, 1) = CDate(datesearch) Then
      ReDim Preserve b(j)
      b(j) = i
      j = j + 1
    End If
  Next
  arr = Application.Index(Cells, Application.Transpose(b), Application.Transpose([row(1:15)]))
  For i = 1 To UBound(arr)
    arr(i, 1) = Format(arr(i, 1), "d/m/yyyy")
  Next
  historial.List = arr
End Sub

Or without using index:

Private Sub CommandButton2_Click()
  Dim sh As Worksheet
  Dim a As Variant, b() As Variant
  Dim i As Long, j As Long, k As Long, n As Long
 
  If datesearch = "" Or Not IsDate(datesearch) Then
    MsgBox "Enter a date"
    datesearch.SetFocus
    Exit Sub
  End If
 
  Set sh = Sheets("register")
  a = sh.Range("A1:O" & sh.Range("A" & Rows.Count).End(3).Row).Value
  n = WorksheetFunction.CountIf(sh.Range("A:A"), CDate(datesearch))
  ReDim b(1 To n, 1 To 15)
  For i = 1 To UBound(a)
    If a(i, 1) = CDate(datesearch) Then
      k = k + 1
      b(k, 1) = Format(a(i, 1), "d/m/yyyy")
      For j = 2 To 15
        b(k, j) = a(i, j)
      Next j
    End If
  Next i
  historial.List = b
End Sub

Hi DanteAmor, thanks for your replay.

The first code has a fault when, for example, I enter a date 6/7/2020 and show an error "runtime error 9" Subscript out of range. When I debug, it shows me the place of the error.

Another detail that does not have this code is that it does not allow me to search intelligently, that is, when I enter only one character, the search should begin and show me the matches that are generated.


The second code works better and not show an error when a type 6/7/2020, but this one doesn't have the smart search either.

However, thanks for your replays and time. These codes help me to advance in the final solution.
Best regards.

 

[DanteAmor]

This type of search on a date is not recommended as you should start searching until you have completed a correct date.
Check that you really have dates in column 1.

 

[purinqui]

This type of search on a date is not recommended as you should start searching until you have completed a correct date.
Check that you really have dates in column 1.

Hi, DanteAmor.

I've really done it, just what you say. But the error is still appear.

The first code has a fault when, for example, I enter a date 6/7/2020 and show an error "runtime error 9" Subscript out of range. When I debug, it shows me the place of the error.

 

[DanteAmor]

It is a problem with your data and you have not put a sample of your data here, you would have to check what is the data of the arrangement that has the problem.
If you can't see what's wrong with your data, I suggest you use my second macro.

 

[purinqui]

It is a problem with your data and you have not put a sample of your data here, you would have to check what is the data of the arrangement that has the problem.
If you can't see what's wrong with your data, I suggest you use my second macro.

Hi DanteAmor:

There is only 3 row with data, and none has a problem.

I think that the problem is on the code in this part:

arr = Application.Index(Cells, Application.Transpose(b), Application.Transpose([row(1:15)]))

When you have only one coincidence, the problem appear.

Thats is the reason, when i put 6/7/2020, the error "runtime error 9" Subscript out of range appears.

 

[DanteAmor]

I don't know if you had a chance to test with more records, but with zero or just one match, the macro has an error because the array is empty.
My mistake, but you will understand that we do not have the time to test all the possible combinations that exist in the data, this I believe, is a team effort.
I made a few adjustments in case there is no data or only have one data.

Private Sub CommandButton1_Click()
  Dim sh As Worksheet
  Dim a As Variant, b() As Variant, arr() As Variant
  Dim i As Long, j As Long
  
  If datesearch = "" Or Not IsDate(datesearch) Then
    MsgBox "Enter a date"
    datesearch.SetFocus
    Exit Sub
  End If
  
  Set sh = Sheets("register")
  a = sh.Range("A1", sh.Range("A" & Rows.Count).End(3)).Value
  
  For i = 1 To UBound(a)
    If a(i, 1) = CDate(datesearch) Then
      ReDim Preserve b(j)
      b(j) = i
      j = j + 1
    End If
  Next
  historial.Clear
  If j = 0 Then
    MsgBox "No records"
    Exit Sub
  ElseIf j = 1 Then
    ReDim Preserve b(j)
    b(j) = sh.Range("A" & Rows.Count).End(3).Row + 1
  End If
  arr = Application.Index(Cells, Application.Transpose(b), Application.Transpose([row(1:15)]))
  For i = 1 To UBound(arr)
    arr(i, 1) = Format(arr(i, 1), "d/m/yyyy")
  Next
  historial.List = arr
End Sub

 

[purinqui]

I don't know if you had a chance to test with more records, but with zero or just one match, the macro has an error because the array is empty.
My mistake, but you will understand that we do not have the time to test all the possible combinations that exist in the data, this I believe, is a team effort.
I made a few adjustments in case there is no data or only have one data.

Private Sub CommandButton1_Click()
  Dim sh As Worksheet
  Dim a As Variant, b() As Variant, arr() As Variant
  Dim i As Long, j As Long

  If datesearch = "" Or Not IsDate(datesearch) Then
    MsgBox "Enter a date"
    datesearch.SetFocus
    Exit Sub
  End If

  Set sh = Sheets("register")
  a = sh.Range("A1", sh.Range("A" & Rows.Count).End(3)).Value

  For i = 1 To UBound(a)
    If a(i, 1) = CDate(datesearch) Then
      ReDim Preserve b(j)
      b(j) = i
      j = j + 1
    End If
  Next
  historial.Clear
  If j = 0 Then
    MsgBox "No records"
    Exit Sub
  ElseIf j = 1 Then
    ReDim Preserve b(j)
    b(j) = sh.Range("A" & Rows.Count).End(3).Row + 1
  End If
  arr = Application.Index(Cells, Application.Transpose(b), Application.Transpose([row(1:15)]))
  For i = 1 To UBound(arr)
    arr(i, 1) = Format(arr(i, 1), "d/m/yyyy")
  Next
  historial.List = arr
End Sub

Hi DanteAmor:

Thanks for your replay, these were very helpful.

I've touch up the code a little, and did a merge with my code... and i've found the solution!!.

The key was in the sentence:

arr = Application.Index(Cells, Application.Transpose(b), Application.Transpose([row(1:15)]))

The solution WITH SMART SEARCH is the next:

Private Sub datesearch_Change()

Worksheets("register").Activate
sizerow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Worksheets("register").AutoFilterMode = False
historial.ColumnHeads = False



Dim x, arr As Variant
Dim b() As Variant
Dim j As Long


'Intelligent Search
i = 1

ReDim Preserve b(j)
  b(0) = 1
  j = 1
For rowin = 2 To sizerow

    dateinput = Worksheets("register").Cells(rowin, 1).Value

            If dateinput Like "*" & Me.datesearch.Value & "*" Or rowin = 1 Then


            ReDim Preserve b(j)
            b(j) = rowin
            j = j + 1

            End If

Next

If j = 0 Then
  MsgBox "No records"
  Exit Sub


Else

  ReDim Preserve b(j)
  b(j) = Worksheets("register").Range("A" & Rows.Count).End(xlUp).Row + 1


End If


arr = Application.Index(Cells, Application.Transpose(b), Application.Transpose([row(1:15)])) 'Generating Array

  'Format of column date of the Array
  For x = 1 To UBound(arr)
    arr(x, 1) = Format(arr(x, 1), "d/m/yyyy")
  Next

historial.List = arr


End Sub


Private Sub UserForm_Initialize()

'Definition of Listbox "historial"
With Me.historial

    .ColumnCount = 15
    .ColumnHeads = True
   
End With


End Sub

Thanks to all for the help.
Topic finished and closed .

Download the file

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.