Sub FillArrayAndDisplay()

Dim size As Integer, z As Integer, i As Integer: i = 1
Dim numbers() As Integer
Dim lrow As Long
  lrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).row
Dim x As Integer: x = 1

Dim txt As String


On Error Resume Next

   size = Application.WorksheetFunction.CountIf(ActiveSheet.Range("b1:b10"), "jim")
   
   ReDim numbers(1 To size)
    
      
      For i = 1 To size
      
                    If i = size - 1 Then
                    Exit For
                    End If
                    
            For x = 1 To lrow
                
                
                    If Cells(x, 2) = "jim" Then
    
                    numbers(i) = Cells(x, 2).Offset(0, -1).Value
                    
                    ReDim Preserve numbers(i)
                    
                    End If
            Next x
      Next i
    
  For i = LBound(numbers) To UBound(numbers)

    
    txt = txt & numbers(i) & vbCrLf
    
  Next i
  
  MsgBox txt


End Sub
Data is in columns A and B of worksheet.
A1:A4 is filled with numbers :2,3,5,3

B1:B4 is filled with names : jim, jim,david, jim

This line of code [/CODE] numbers(i) = Cells(x, 2).Offset(0, -1).Value [/CODE]picks up the numbers in Column A
based on this statement : [/CODE] If Cells(x, 2) = "jim" Then [/CODE]

So I only want the numbers for jim to fill the array.

Unfortunately when results are displayed via the message box they are : 3,0,0.
So the array appears to be filled with the last number for Jim (3) and then two zeroes which do not correspond to Jim.

Any help solving this problem would be greatly appreciated.

Many thanks for reading