CODEWITHSUNDEEP
vbaexcel
paulinhax
paulinhax

Reputation: 602

VBA find and findnext to paste values

I have this sheet where I want to use Find and FindNext to search for values on another sheet BD and copy them to my main sheet Plan1 if the value on alocacao matches cells on Column 5.

I used to have 4 spaces with named ranges tecnico1, tecnico2, tecnico3 and tecnico4 to paste the values and the code works fine.

This is how it looks:

enter image description here

And the BD sheet:

enter image description here

And this is the code:

Sub VerifProd_Click()
    Dim FoundCell As Range, FirstAddr As String, fnd As String, i As Long

    fnd = Sheets(1).Range("alocacao").Value

    Set FoundCell = Sheets("BD").Columns(5).Find(what:=fnd, _
        After:=Sheets("BD").Cells(Rows.Count, 5), Lookat:=xlPart, _
        LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext)

    If FoundCell Is Nothing Then Exit Sub

    Do
        i = i + 1
        Sheets("Plan1").Range("tecnico" & i).Value = FoundCell.Offset(, -3).Value
        Sheets("Plan1").Range("upps0" & i).Value = FoundCell.Offset(, -1).Value

        Set FoundCell = Sheets("BD").Columns(5).FindNext(After:=FoundCell)
    Loop Until FoundCell.Address = FirstAddr Or i >= 4
End Sub

However, now I realize that I'll need more fields because I maybe insert more than 4 tecnicos on an alocacao. So now this is how it looks:

enter image description here

And I just changed this part of the code:

If FoundCell Is Nothing Then Exit Sub

        Do
            i = i + 1
            Sheets("Plan1").Range("tecnico" & i).Value = FoundCell.Offset(, -3).Value
            Sheets("Plan1").Range("upps0" & i).Value = FoundCell.Offset(, -1).Value

            Set FoundCell = Sheets("BD").Columns(5).FindNext(After:=FoundCell)
        Loop Until FoundCell.Address = FirstAddr Or i >= 10

So I was expecting that it just fills 4 fields as I still have only 4 matches, but I got this result:

enter image description here

As I'm new using Find and FindNext, I really don't know what I have to change to fill the cells with the matches only without repeating it.

Any suggestions will help! Maybe there is something I couldn't notice there.

Upvotes: 1

Views: 759

Answers (1)

paulinhax
paulinhax

Reputation: 602

I just used the suggestion of @Luuklag and now it's working.

Sub VerifProd_Click()
    Dim FoundCell As Range, FirstAddr As String, fnd As String, i As Long

    fnd = Sheets(1).Range("alocacao").Value

    Set FoundCell = Sheets("BD").Columns(5).Find(what:=fnd, _
        After:=Sheets("BD").Cells(Rows.Count, 5), Lookat:=xlPart, _
        LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext)

    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If
    If FoundCell Is Nothing Then Exit Sub

    Do
        i = i + 1
        Sheets("Plan1").Range("tecnico" & i).Value = FoundCell.Offset(, -3).Value
        Sheets("Plan1").Range("upps0" & i).Value = FoundCell.Offset(, -1).Value

        Set FoundCell = Sheets("BD").Columns(5).FindNext(After:=FoundCell)
    Loop Until FoundCell.Address = FirstAddr Or i >= 10
End Sub

Upvotes: 1

Related Questions