CODEWITHSUNDEEP
vbaexcelfindmatch
Jean
Jean

Reputation: 99

Select all cells matching my find criteria

I´m writing a simple macro for searching my value in table. I know that searched value is in the document many times. But my macro finds just first value in table. I want select all rows with the value I´m looking for. Then I want copy selected rows and copy them to "sheet2". Can somebody help me adjust my macro? Thx

Sub Vyhladat()

Sheets("Sheet1").Columns(24).Find(What:=InputBox("Please enter your LR number", "Search")).Select
ActiveCells.EntireRow.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select

Do
If IsEmpty(ActiveCell.Value) Then
    ActiveCell.PasteSpecial xlPasteValues
    End
Else
    ActiveCell.Offset(1, 0).Select
End If

Loop

End Sub

Upvotes: 2

Views: 4676

Answers (1)

R3uK
R3uK

Reputation: 14537

Here is how to do it (find the first match and then loop with the FindNext() method) :

Sub test_Jean()
Dim FirstAddress As String, _
    cF As Range, _
    RowsToCopy As String

ActiveSheet.Cells(1, 24).Activate
With ActiveSheet.Columns(24)
    'First, define properly the Find method
    Set cF = .Find(What:=InputBox("Please enter your LR number", "Search"), _
                After:=ActiveCell, _
                LookIn:=xlFormulas, _
                LookAt:=xlPart, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlNext, _
                MatchCase:=False, _
                SearchFormat:=False)

    'If there is a result, keep looking with FindNext method
    If Not cF Is Nothing Then
        FirstAddress = cF.Address
        Do
            cF.EntireRow.Copy
            Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
            Set cF = .FindNext(cF)
        'Look until you find again the first result
        Loop While Not cF Is Nothing And cF.Address <> FirstAddress
    End If
End With

End Sub

Upvotes: 3

Related Questions