Stuck in loop

[Caze982]

Hi everyone i am a total newbee in VBA and i am trying to lean about arrays. I have written the following code and get stuck in an infinite messagebox loop. Is there anyone that knows how to write the code and not get stuck in the loop?

Sub FindProduct()
Dim code() As String
Dim price() As Double
Dim NumProducts As Integer
Dim i As Integer
Dim p_code As String

'Read number of products:
NumProducts = Range("D1").Value

'Resize the arrays:
ReDim code(NumProducts)
ReDim price(NumProducts)

'Store information in the arrays:
For i = 1 To NumProducts
code(i) = Cells(i + 3, 1)
price(i) = Cells(i + 3, 2)
Next


p_code = InputBox("Please enter a product code:")

'Search in the code array:
For i = 1 To NumProducts
If code(i) = p_code Then
MsgBox "The price of product " & p_code & " is " & price(i)
Else
MsgBox "The product name is in the list "
End If
Next

End Sub

 

[dmt32]

Hi welcome to the board.

You can read your ranges into arrays without looping.

As an example, have a play with following & see if helps:

Sub FindProduct()
    Dim ProductCode As Variant, ProductPrice As Variant
    Dim GetCode As Variant, m As Variant


    ProductCode = Application.Transpose(Range(Range("A4"), Range("A" & Rows.Count).End(xlUp)).Value)


    ProductPrice = Application.Transpose(Range(Range("B4"), Range("B" & Rows.Count).End(xlUp)).Value)


    Do
        GetCode = InputBox("Enter Product Code", "Product Code")
        'cancel pressed
        If StrPtr(GetCode) = 0 Then Exit Sub
    Loop Until IsNumeric(GetCode)


    'find code in ProductCode array
    m = Application.Match(CLng(GetCode), ProductCode, False)


    If Not IsError(m) Then
        MsgBox "Product Code: " & GetCode & Chr(10) & Chr(10) & _
               "Product Price: " & ProductPrice(m), 48, "Product Price"
    Else
        MsgBox "The product name is in the list "
    End If


End Sub

I have assumed that your product code is NUMERIC only - code will need to be adjusted for other data types.

Alternatively, you could use Find Function:

Sub FindProduct2()
    Dim FoundCell As Range


    Do
        GetCode = InputBox("Enter Product Code", "Product Code")
        'cancel pressed
        If StrPtr(GetCode) = 0 Then Exit Sub
    Loop Until IsNumeric(GetCode)


    Set FoundCell = Sheets("Sheet1").Columns(1).Find(GetCode, lookat:=xlWhole, LookIn:=xlValues)
    If Not FoundCell Is Nothing Then
        MsgBox "Product Code: " & GetCode & Chr(10) & Chr(10) & _
               "Product Price: " & FoundCell.Offset(0, 1).Text, 48, "Product Price"
    Else
        MsgBox "Product Code: " & GetCode & Chr(10) & Chr(10) & _
                   "Record Not Found", 48, "Not Found"
    End If


End Sub

Again I have assumed Product Code is Numeric & sheet with Data is named "Sheet1" adjust code as required.

Hope Helpful

Dave

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

I guess you are looking for something like this:

    Dim code() As String
    Dim price() As Double
    Dim NumProducts As Long
    Dim i As Long
    Dim p_code As String
    Dim Found As Boolean
    
    'Read number of products:
    NumProducts = Range("D1").Value
    
    'Resize the arrays:
    ReDim code(NumProducts)
    ReDim price(NumProducts)
    
    'Store information in the arrays:
    For i = 1 To NumProducts
        code(i) = Cells(i + 3, 1)
        price(i) = Cells(i + 3, 2)
    Next
    
    p_code = InputBox("Please enter a product code:")
    
    'Search in the code array and note if found:
    Found = False
    For i = 1 To NumProducts
        If code(i) = p_code Then
            Found = True
            Exit For
        End If
    Next

    ' Display the search results
    If Found Then
        MsgBox "The price of product " & p_code & " is " & price(i)
    Else
        MsgBox "The product name is not in the list "
    End If
    
End Sub

The search and the reporting of the results need to be in separate steps. So I created a flag called Found that would set to True if a part number was located in the list.

 

[Caze982]

Thanks !!

 

[RickXL]

No problem.