SOLVED

Why is this VBA code populating only the first occurrence found in the range?

Occasional Contributor

Hello,

The idea is to get the selected value, which is a date, and look for occurrences in a range matching that date and then load them into a listbox.

 

Here's what I've got so far, but:

01 - It's loading only one row, although there's more;

02 - One of the columns has data like this 00:00 and it's coming as 0,5

 

Private Sub UserForm_Initialize()
Dim myCustNo, myList(), n As Long, r As Range

myCustNo = ActiveCell.Value
With Sheets("PartsData")
     With .Range("C1", .Range("C" & Rows.Count).End(xlUp))
          If WorksheetFunction.CountIf(.Cells, myCustNo) = 0 Then
               MsgBox "No actions found": Exit Sub
          End If
          For Each r In .Cells
               If r.Value = myCustNo Then
                    n = n + 1
                    ReDim Preserve myList(1 To 3, 1 To n)
                    myList(1, n) = r.Value: myList(2, n) = r.Offset(, -1).Value
                    myList(3, n) = r.Offset(, -2).Value
                End If
          Next
     End With
End With
With Me.ListBox1
     .ColumnCount = 3
     .ColumnWidths = "50;50;50"  '<- adjust to suite
     .Column = myList
End With
End Sub

 

Here's the range it should iterate through:
 

asantos2021_0-1637853775475.png

 

I appreciate any help!

 

Antonio

5 Replies

@asantos2021 

Could you attach a small sample workbook without sensitive data?

@Hans Vogelaar ,

Here it is! Thanks a lot!

best response confirmed by asantos2021 (Occasional Contributor)
Solution

@asantos2021 

1) Change

myList(2, n) = r.Offset(, -1).Value

to

myList(2, n) = Format(r.Offset(, -1).Value, "hh:mm")

2) There are no duplicate dates in PartsData column C (please note that C5 is in 2020 and C7 is in 2021).

If there are duplicate dates, the list box will display all of them.

That did work! Thanks a lot. Now...this is not updating, getting the rows added to the bottom of the range. Not expecting you to spend more time on it, as you've helped a lot already...just thinking out loud

@asantos2021 

It works for me:

S0932.png

 

S0933.png

 

Workbook attached.