Need Help Please - VBA code will not stop looping . . .

[Lidsavr]

I am using Excel 2007 and writing code that both Excel 2007 and Excel 2003 users will run.

I am trying to select a range of part numbers in Column D and it finds the part number correctly and then in looping selects the three other instance of the same part number, but then instead of stopping the loop, continues to select all the way to the spreadsheet. I need it to stop with the last instance of the part number that is designated. In my test case, the part number is I am designating is: ARCT04371. I know there a four instances of this part in the spreadsheet (It makes it a good test of the program)

Here is the subroutine code I have developed so far. I do not know why it doesn't stop looping the do loop section is in red:

'   [COLOR="Green"]The user selects a part number from the list box and it is placed
'   into cell D1 on worksheet Bd_Pns[/COLOR]    
    Range(Selection, Selection.End(xlDown)).Select
    Set SRng = Selection
    Range("A1").Select
    With UserForm3.ListBox1
        .BoundColumn = 1
        .ColumnCount = 1
        .ControlSource = "'Bd_Pns'!$D$1"   'places the selection in cell D1
        .IntegralHeight = True
        .MultiSelect = 0
        .RowSource = SRng.Address
    End With
    If TypeName(Selection) = "Range" Then
        UserForm3.Show
    End If
    Sheets("Bd_PNs").Select
    Range("D1").Select
    MyVar1 = ActiveCell.Value

[COLOR="green"]'   Finds MyVar1 on the part number worksheet and selects
'   all instances[/COLOR]
    Sheets("ARCT00232").Select
    Range("D:D").Find(What:=MyVar1, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Select
[COLOR="Red"]    Do
        If ActiveCell.Offset(1, 0).Value = MyVar1 Then
            Range(Selection, Selection.Offset(1, 0)).Select
        End If
    Loop Until ActiveCell.Offset(1, 0).Value <> MyVar1[/COLOR]

[COLOR="Green"]'   The problem is the code keeps selecting after the four instances of the 
'   part number.[/COLOR]

What am I missing here? I've spent over two hours trying different commands and syntax without success. Any help with the code is appreciated.

Thank you,

Charles

 

[Norie]

Charles

I don't think you are actually moving anywhere.

This will find all the instances of the var1 after the first instance and create a reference rngAll to them.

    Set rng = ActiveCell
    
    Set rngAll = rng
 
    Do
 
        If rng.Offset(1).Value = var1 Then
            Set rngAll = Union(rngAll, rng.Offset(1))
        End If

        Set rng = rng.Offset(1)
 
    Loop Until rng.Value <> var1
 
    rngAll.Select

 

[Lidsavr]

Norie,
Thank you very much. I will test this code out this afternoon. It may meet my needs in other ways as well.

I appreciate the help!

Charles

 

[Norie]

Charles

No problem.

Something I forgot to mention is that I've assumed that the values you are looking for are contiguous, eg in a 'block'.