Problem with populate listbox using Application.Index

purinqui

New Member
Joined
Nov 30, 2019
Messages
29
Office Version
  1. 2019
Platform
  1. Windows
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:

VBA Code:
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:


a.PNG


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:

 

Attachments

  • a.PNG
    a.PNG
    8.7 KB · Views: 22

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
I dont know how can i do, to manage the variable rows to be implemented with the Method Application.index.

Could be like this:
VBA Code:
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:
VBA Code:
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
 
Upvote 0
Could be like this:
VBA Code:
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:
VBA Code:
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.

aa.png



aaa.JPG


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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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:

VBA Code:
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.
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0
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.

VBA Code:
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:

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

The solution WITH SMART SEARCH is the next:

VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,216,165
Messages
6,129,235
Members
449,496
Latest member
Patupaiarehe

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top