CODEWITHSUNDEEP
excelvba
Savagefool
Savagefool

Reputation: 223

Search each row, paste each match - Excel VBA

So I can search but I'm having problems with the loop, here is an example for some context:

Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("DCCUEQ").Range("1:20") 'searches all of rows 1 to 20
    Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
        Application.Goto Rng, True 'value found
        MsgBox ("Value Found" & Rng)
    Else
        MsgBox "Nothing found" 'value not found
    End If
End With
End If
End Sub

There are a few things I need to do with this

If FindString is on a row, Copy and paste that row (From A:F) to Sheet3 starting from row 5
Skip the rest of that row and search the next row on DCCUEQ
check and paste under the previously pasted row (on Sheet3) if the requirements are met
Loop this until no information is found on a row

It is part of a large program so if I can get some slight aid in filling this part of the code I can do the rest quite easily by following the logic

Any help or direction to the information to aid me on an answer would be appreciated please.

Upvotes: 0

Views: 115

Answers (2)

J Reid
J Reid

Reputation: 461

Sticking with Find since you may want to copy formats. Note Rng0 is to prevent an infinite loop when find wraps back around.

Sub Find_First()

Dim Rng As Range
Dim Rng0 As Range
Dim NextRow As Integer
Dim FindString As String
FindString = InputBox("Enter a Search value")

Dim dest As Worksheet
Set dest = Worksheets("Sheet3")

If Trim(FindString) <> "" Then
   With Sheets("DCCUEQ").Range("1:20")
      Set Rng0 = .Find(What:=FindString, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
      NextRow = 5
      Set Rng = Rng0
      While Not Rng Is Nothing
         .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 6)).Copy dest.Range(dest.Cells(NextRow, 1), dest.Cells(NextRow, 6))
         NextRow = NextRow + 1
         Set Rng = .Find(What:=FindString, _
                   After:=Rng, _
                   LookIn:=xlValues, _
                   LookAt:=xlWhole, _
                   SearchOrder:=xlByRows, _
                   SearchDirection:=xlNext, _
                   MatchCase:=False)
         If Rng.Address = Rng0.Address Then Set Rng = Nothing
      Wend

   End With
End If

End Sub

Upvotes: 2

R&#233;mi
R&#233;mi

Reputation: 372

I think using 2 For loops (one for the columns and one for the rows) would work perfectly in your context.

You set a cell with your two variables for the address and compare it to your string. If it is the same, then you copy/paste and exit the loop of columns so it skips the rest of the row.

Sub Find_First()

Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")

    If Trim(FindString) <> "" Then

        With Sheets("DCCUEQ")

            Dim s3r As Integer, i As Integer, j As Integer
            s3r = 4 'this would determine the row in Sheet3

            For i = 1 To 20

                For j = 1 To 10 'Let's say the last column is J

                    Set Rng = .Cells(i, j)

                    If Rng = FindString Then
                        s3r = s3r + 1
                        .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 6)).Copy Destination:=Worksheets("Sheet3").Range(Worksheets("Sheet3").Cells(s3r, 1), Worksheets("Sheet3").Cells(s3r, 6))
                        Exit For 'it will go to the next row
                    End If

                Next j

            Next i

            If s3r = 4 Then MsgBox "Nothing found"

        End With

    End If

End Sub

Let me know if this way suits you.

Upvotes: 3

Related Questions